?
Solved

How to upgrade from Microsoft xml version 2 to Microsoft xml version 4

Posted on 2012-09-15
12
Medium Priority
?
669 Views
Last Modified: 2012-09-16
Hello,

I'm enhancing an existing Excel application written by another developer, several years ago.  The problem is that he was using Microsoft xml version 2.0 which is throwing a error when the application is launched using Excel 2007.  I would need some help in getting started to update the following code to at least Microsoft version 4.0.  Does anyone know of any guides to perform the update process?
Private Function sendXML(strXML, strResponse, strURL As String) As Long
    ' Comments:
    ' Params  : strXML
    '           strResponse
    '           strURL
    ' Returns : Long
    ' Modified:
    
    Dim xDoc As MSXML.DOMDocument
    
    Dim xHTTP As MSXML.XMLHTTPRequest
    'Dim xError, xImported, xUpdated As MSXML.IXMLDOMElement
    Dim varXError
    Dim varXImported
    Dim xUpdated As MSXML.IXMLDOMNodeList
    Dim varTmp
    Dim strTmp2 As String
    Dim lngStatusNum As Long
    Dim varI
    Dim intK As Integer
    Dim varY
    Dim varM
    Dim varD
    Dim varDsep
    Dim strJdate As String
    Dim intDorder As Integer
    
    On Error GoTo doError
    strResponse = ""
    Set xDoc = New MSXML.DOMDocument
    xDoc.async = False
    If xDoc.loadXML(strXML) Then
        Set xHTTP = New MSXML.XMLHTTPRequest
        
        xHTTP.Open "POST", strURL, False
        
        xHTTP.setRequestHeader "content-type", "application/x-www-form-urlencoded"
        xHTTP.setRequestHeader "accept", "text/xml/html"
        xHTTP.setRequestHeader "accept-charset", "utf-8, iso_8859-1"
        
        xHTTP.send xDoc.XML
        strResponse = xHTTP.ResponseText
        
        strResponse = Replace(strResponse, """, """")
        strResponse = Replace(strResponse, "&lt;", "<")
        strResponse = Replace(strResponse, "&gt;", ">")
        strResponse = Replace(strResponse, "&amp;", "&")
        
        If xDoc.loadXML(strResponse) Then
            varDsep = Application.International(xlDateSeparator)
            intDorder = Application.International(xlDateOrder)
            'xlDateOrder (0=MDY, 1=DMY, 2=YMD)
            Set varXError = xDoc.getElementsByTagName("error")
            strResponse = ""
            If varXError.Length = 0 Then
                sendXML = 0
                Set varXImported = xDoc.getElementsByTagName("imported")
                varTmp = ""
                intK = 0
                
                For varI = 1 To varXImported.Length
                    strTmp2 = varXImported.Item(varI - 1).Text
                    varY = Left(Right(strTmp2, 10), 4)
                    varM = Left(Right(strTmp2, 5), 2)
                    varD = Right(strTmp2, 2)
                    If intDorder = 0 Then
                        strJdate = varM & varDsep & varD & varDsep & varY
                    ElseIf intDorder = 1 Then
                        strJdate = varD & varDsep & varM & varDsep & varY
                    Else
                        strJdate = varY & varDsep & varM & varDsep & varD
                    End If
                    
                    varTmp = varTmp & vbLf & "  " & Left(strTmp2, Len(strTmp2) - 10) & strJdate
                    intK = intK + 1
                Next
                strResponse = GetMsg(Lang, 80, 2, str(intK)) & varTmp
                
                Set xUpdated = xDoc.getElementsByTagName("updated")
                varTmp = ""
                intK = 0
                For varI = 1 To xUpdated.Length
                    strTmp2 = xUpdated.Item(varI - 1).Text
                    varY = Left(Right(strTmp2, 10), 4)
                    varM = Left(Right(strTmp2, 5), 2)
                    varD = Right(strTmp2, 2)
                    If intDorder = 0 Then
                        strJdate = varM & varDsep & varD & varDsep & varY
                    ElseIf intDorder = 1 Then
                        strJdate = varD & varDsep & varM & varDsep & varY
                    Else
                        strJdate = varY & varDsep & varM & varDsep & varD
                    End If
                    
                    varTmp = varTmp & vbLf & "  " & Left(strTmp2, Len(strTmp2) - 10) & strJdate
                    intK = intK + 1
                Next
                If intK > 0 Then
                    strResponse = strResponse & vbLf & GetMsg(Lang, 80, 3, str(intK)) & varTmp
                End If
            Else
                'Application Error message found
                sendXML = -104
                varI = 0
                For varI = 1 To varXError.Length
                    If varI > 1 Then
                        strResponse = strResponse & vbLf
                    End If
                    strResponse = strResponse & varXError.Item(varI - 1).Text
                Next
            End If
        Else
            'Error loading response XML document
            sendXML = -103
        End If
    Else
        'Error loading the source XML document
        sendXML = -102
        strResponse = xDoc.parseError.reason & vbCrLf & strXML
    End If
    Exit Function
doError:
    If Err.Number <> 0 Then
        sendXML = Err.Number
        strResponse = Err.Description & Range("Import_URL").Value
    Else
        'Unknown error
        sendXML = -101
    End If
End Function

Open in new window

0
Comment
Question by:chtullu135
  • 9
  • 3
12 Comments
 

Author Comment

by:chtullu135
ID: 38402248
I've been doing some more research and I think I have to replace MSXML with MSXML2 in the code
0
 

Author Comment

by:chtullu135
ID: 38402286
A thought has occurred to me with respect to the environment in which the application will be running.  The client is using Excel 2007 but some users have already started to use Excel 2010.  Should I move up to Microsoft xml version 5.0 instead.
0
 

Author Comment

by:chtullu135
ID: 38402343
I've changed the code to the following by replacing MSXML with MSXML2.  However, it appears that XMLHTTPRequest is not supported in Microsoft XML version 5.  What would be a workaround.  I'm not too familiar with XML

Private Function sendXML(strXML, strResponse, strURL As String) As Long
    ' Comments:
    ' Params  : strXML
    '           strResponse
    '           strURL
    ' Returns : Long
    ' Modified:
    
    Dim xDoc As MSXML2.DOMDocument
    
    Dim xHTTP As MSXML.XMLHTTPRequest
    'Dim xError, xImported, xUpdated As MSXML.IXMLDOMElement
    Dim varXError
    Dim varXImported
    Dim xUpdated As MSXML2.IXMLDOMNodeList
    Dim varTmp
    Dim strTmp2 As String
    Dim lngStatusNum As Long
    Dim varI
    Dim intK As Integer
    Dim varY
    Dim varM
    Dim varD
    Dim varDsep
    Dim strJdate As String
    Dim intDorder As Integer
    
    On Error GoTo doError
    strResponse = ""
    Set xDoc = New MSXML2.DOMDocument
    xDoc.async = False
    If xDoc.loadXML(strXML) Then
        Set xHTTP = New MSXML.XMLHTTPRequest
        
        xHTTP.Open "POST", strURL, False
        
        xHTTP.setRequestHeader "content-type", "application/x-www-form-urlencoded"
        xHTTP.setRequestHeader "accept", "text/xml/html"
        xHTTP.setRequestHeader "accept-charset", "utf-8, iso_8859-1"
        
        xHTTP.send xDoc.XML
        strResponse = xHTTP.ResponseText
        
        strResponse = Replace(strResponse, "&quot;", """")
        strResponse = Replace(strResponse, "&lt;", "<")
        strResponse = Replace(strResponse, "&gt;", ">")
        strResponse = Replace(strResponse, "&amp;", "&")
        
        If xDoc.loadXML(strResponse) Then
            varDsep = Application.International(xlDateSeparator)
            intDorder = Application.International(xlDateOrder)
            'xlDateOrder (0=MDY, 1=DMY, 2=YMD)
            Set varXError = xDoc.getElementsByTagName("error")
            strResponse = ""
            If varXError.Length = 0 Then
                sendXML = 0
                Set varXImported = xDoc.getElementsByTagName("imported")
                varTmp = ""
                intK = 0
                
                For varI = 1 To varXImported.Length
                    strTmp2 = varXImported.Item(varI - 1).Text
                    varY = Left(Right(strTmp2, 10), 4)
                    varM = Left(Right(strTmp2, 5), 2)
                    varD = Right(strTmp2, 2)
                    If intDorder = 0 Then
                        strJdate = varM & varDsep & varD & varDsep & varY
                    ElseIf intDorder = 1 Then
                        strJdate = varD & varDsep & varM & varDsep & varY
                    Else
                        strJdate = varY & varDsep & varM & varDsep & varD
                    End If
                    
                    varTmp = varTmp & vbLf & "  " & Left(strTmp2, Len(strTmp2) - 10) & strJdate
                    intK = intK + 1
                Next
                strResponse = GetMsg(Lang, 80, 2, str(intK)) & varTmp
                
                Set xUpdated = xDoc.getElementsByTagName("updated")
                varTmp = ""
                intK = 0
                For varI = 1 To xUpdated.Length
                    strTmp2 = xUpdated.Item(varI - 1).Text
                    varY = Left(Right(strTmp2, 10), 4)
                    varM = Left(Right(strTmp2, 5), 2)
                    varD = Right(strTmp2, 2)
                    If intDorder = 0 Then
                        strJdate = varM & varDsep & varD & varDsep & varY
                    ElseIf intDorder = 1 Then
                        strJdate = varD & varDsep & varM & varDsep & varY
                    Else
                        strJdate = varY & varDsep & varM & varDsep & varD
                    End If
                    
                    varTmp = varTmp & vbLf & "  " & Left(strTmp2, Len(strTmp2) - 10) & strJdate
                    intK = intK + 1
                Next
                If intK > 0 Then
                    strResponse = strResponse & vbLf & GetMsg(Lang, 80, 3, str(intK)) & varTmp
                End If
            Else
                'Application Error message found
                sendXML = -104
                varI = 0
                For varI = 1 To varXError.Length
                    If varI > 1 Then
                        strResponse = strResponse & vbLf
                    End If
                    strResponse = strResponse & varXError.Item(varI - 1).Text
                Next
            End If
        Else
            'Error loading response XML document
            sendXML = -103
        End If
    Else
        'Error loading the source XML document
        sendXML = -102
        strResponse = xDoc.parseError.reason & vbCrLf & strXML
    End If
    Exit Function
doError:
    If Err.Number <> 0 Then
        sendXML = Err.Number
        strResponse = Err.Description & Range("Import_URL").Value
    Else
        'Unknown error
        sendXML = -101
    End If
End Function

Open in new window

0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

Author Comment

by:chtullu135
ID: 38402398
I did some more research and found the following website (See MSXML below). When I set
  Set xHTTP = New MSXML2.XMLHTTP40, the code compiled properly.  I'll try it out on Monday when I get to work

MSXML

Private Function sendXML(strXML, strResponse, strURL As String) As Long
    ' Comments:
    ' Params  : strXML
    '           strResponse
    '           strURL
    ' Returns : Long
    ' Modified:
    
    Dim xDoc As MSXML2.DOMDocument60
    
    'Dim xHTTP As MSXML2.XMLHTTPRequest
    Dim xHTTP As MSXML2.XMLHTTP40
    'Dim xError, xImported, xUpdated As MSXML.IXMLDOMElement
    Dim varXError
    Dim varXImported
    Dim xUpdated As MSXML2.IXMLDOMNodeList
    Dim varTmp
    Dim strTmp2 As String
    Dim lngStatusNum As Long
    Dim varI
    Dim intK As Integer
    Dim varY
    Dim varM
    Dim varD
    Dim varDsep
    Dim strJdate As String
    Dim intDorder As Integer
    
    On Error GoTo doError
    strResponse = ""
    Set xDoc = New MSXML2.DOMDocument
    xDoc.async = False
    If xDoc.loadXML(strXML) Then
        'Set xHTTP = New MSXML.XMLHTTPRequest
        
        Set xHTTP = New MSXML2.XMLHTTP40
        
        xHTTP.Open "POST", strURL, False
        
        xHTTP.setRequestHeader "content-type", "application/x-www-form-urlencoded"
        xHTTP.setRequestHeader "accept", "text/xml/html"
        xHTTP.setRequestHeader "accept-charset", "utf-8, iso_8859-1"
        
        xHTTP.send xDoc.XML
        strResponse = xHTTP.ResponseText
        
        strResponse = Replace(strResponse, "&quot;", """")
        strResponse = Replace(strResponse, "&lt;", "<")
        strResponse = Replace(strResponse, "&gt;", ">")
        strResponse = Replace(strResponse, "&amp;", "&")
        
        If xDoc.loadXML(strResponse) Then
            varDsep = Application.International(xlDateSeparator)
            intDorder = Application.International(xlDateOrder)
            'xlDateOrder (0=MDY, 1=DMY, 2=YMD)
            Set varXError = xDoc.getElementsByTagName("error")
            strResponse = ""
            If varXError.Length = 0 Then
                sendXML = 0
                Set varXImported = xDoc.getElementsByTagName("imported")
                varTmp = ""
                intK = 0
                
                For varI = 1 To varXImported.Length
                    strTmp2 = varXImported.Item(varI - 1).Text
                    varY = Left(Right(strTmp2, 10), 4)
                    varM = Left(Right(strTmp2, 5), 2)
                    varD = Right(strTmp2, 2)
                    If intDorder = 0 Then
                        strJdate = varM & varDsep & varD & varDsep & varY
                    ElseIf intDorder = 1 Then
                        strJdate = varD & varDsep & varM & varDsep & varY
                    Else
                        strJdate = varY & varDsep & varM & varDsep & varD
                    End If
                    
                    varTmp = varTmp & vbLf & "  " & Left(strTmp2, Len(strTmp2) - 10) & strJdate
                    intK = intK + 1
                Next
                strResponse = GetMsg(Lang, 80, 2, str(intK)) & varTmp
                
                Set xUpdated = xDoc.getElementsByTagName("updated")
                varTmp = ""
                intK = 0
                For varI = 1 To xUpdated.Length
                    strTmp2 = xUpdated.Item(varI - 1).Text
                    varY = Left(Right(strTmp2, 10), 4)
                    varM = Left(Right(strTmp2, 5), 2)
                    varD = Right(strTmp2, 2)
                    If intDorder = 0 Then
                        strJdate = varM & varDsep & varD & varDsep & varY
                    ElseIf intDorder = 1 Then
                        strJdate = varD & varDsep & varM & varDsep & varY
                    Else
                        strJdate = varY & varDsep & varM & varDsep & varD
                    End If
                    
                    varTmp = varTmp & vbLf & "  " & Left(strTmp2, Len(strTmp2) - 10) & strJdate
                    intK = intK + 1
                Next
                If intK > 0 Then
                    strResponse = strResponse & vbLf & GetMsg(Lang, 80, 3, str(intK)) & varTmp
                End If
            Else
                'Application Error message found
                sendXML = -104
                varI = 0
                For varI = 1 To varXError.Length
                    If varI > 1 Then
                        strResponse = strResponse & vbLf
                    End If
                    strResponse = strResponse & varXError.Item(varI - 1).Text
                Next
            End If
        Else
            'Error loading response XML document
            sendXML = -103
        End If
    Else
        'Error loading the source XML document
        sendXML = -102
        strResponse = xDoc.parseError.reason & vbCrLf & strXML
    End If
    Exit Function
doError:
    If Err.Number <> 0 Then
        sendXML = Err.Number
        strResponse = Err.Description & Range("Import_URL").Value
    Else
        'Unknown error
        sendXML = -101
    End If
End Function

Open in new window

0
 
LVL 46

Expert Comment

by:aikimark
ID: 38403412
I might suggest that you do late binding instead of early binding.  Use CreateObject() to instantiate your variables and remove the References.
0
 

Author Comment

by:chtullu135
ID: 38403516
So i would use something like the following?

 Dim xHTTP As Object
 SET xHTTP = CreateObject("MSXML2.XMLHTTP40")  
 Dim xUpdated As Obect
 SET xUpdated = CreateObject("MSXML2.IXMLDOMNodeList")
0
 
LVL 46

Accepted Solution

by:
aikimark earned 2000 total points
ID: 38403614
I'm hoping that you will be able to use the generic
CreateObject("MSXML2.XMLHTTP")

instead of the version-specific
CreateObject("MSXML2.XMLHTTP.4.0")

The generic is preferred if you can't be assured of the version that will exist on the run-time PC.
0
 

Author Comment

by:chtullu135
ID: 38403653
I  see what you mean.  I'll rewrite the code using late binding using the generic and post the resulting code.
0
 
LVL 46

Expert Comment

by:aikimark
ID: 38403812
I still isn't clear what the problem is, unless your references mismatch the versions on the target PCs.
0
 

Author Comment

by:chtullu135
ID: 38403835
There isn't a problem.  I'll test it out and post the code in the event others have a similar issue
0
 

Author Comment

by:chtullu135
ID: 38403906
Here is the final code.  I've tested it and it seems to be working fine.
'=========================================
'  Post and Send billing data over the web
'=========================================
Private Function sendXML(strXML, strResponse, strURL As String) As Long
    ' Comments:
    ' Params  : strXML
    '           strResponse
    '           strURL
    ' Returns : Long
    ' Modified:
    
    'Dim xDoc As MSXML2.DOMDocument60
    Dim xDoc As Object
    
    
    'Dim xHTTP As MSXML2.XMLHTTP40
    Dim xHTTP As Object
    'Dim xError, xImported, xUpdated As MSXML.IXMLDOMElement
    Dim varXError
    Dim varXImported
    'Dim xUpdated As MSXML2.IXMLDOMNodeList
    Dim xUpdated As Object
    
    Dim varTmp
    Dim strTmp2 As String
    Dim lngStatusNum As Long
    Dim varI
    Dim intK As Integer
    Dim varY
    Dim varM
    Dim varD
    Dim varDsep
    Dim strJdate As String
    Dim intDorder As Integer
    
    On Error GoTo doError
    strResponse = ""
    'Set xDoc = New MSXML2.DOMDocument
    Set xDoc = CreateObject("MSXLM2.DOMDocument")
    xDoc.async = False
    If xDoc.loadXML(strXML) Then
        'Set xHTTP = New MSXML.XMLHTTPRequest
        
        'Set xHTTP = New MSXML2.XMLHTTP40
        Set xHTTP = CreateObject("MSXML2.XMLHTTP")
        
        xHTTP.Open "POST", strURL, False
        
        xHTTP.setRequestHeader "content-type", "application/x-www-form-urlencoded"
        xHTTP.setRequestHeader "accept", "text/xml/html"
        xHTTP.setRequestHeader "accept-charset", "utf-8, iso_8859-1"
        
        xHTTP.send xDoc.XML
        strResponse = xHTTP.ResponseText
        
        strResponse = Replace(strResponse, "&quot;", """")
        strResponse = Replace(strResponse, "&lt;", "<")
        strResponse = Replace(strResponse, "&gt;", ">")
        strResponse = Replace(strResponse, "&amp;", "&")
        
        If xDoc.loadXML(strResponse) Then
            varDsep = Application.International(xlDateSeparator)
            intDorder = Application.International(xlDateOrder)
            'xlDateOrder (0=MDY, 1=DMY, 2=YMD)
            Set varXError = xDoc.getElementsByTagName("error")
            strResponse = ""
            If varXError.Length = 0 Then
                sendXML = 0
                Set varXImported = xDoc.getElementsByTagName("imported")
                varTmp = ""
                intK = 0
                
                For varI = 1 To varXImported.Length
                    strTmp2 = varXImported.Item(varI - 1).Text
                    varY = Left(Right(strTmp2, 10), 4)
                    varM = Left(Right(strTmp2, 5), 2)
                    varD = Right(strTmp2, 2)
                    If intDorder = 0 Then
                        strJdate = varM & varDsep & varD & varDsep & varY
                    ElseIf intDorder = 1 Then
                        strJdate = varD & varDsep & varM & varDsep & varY
                    Else
                        strJdate = varY & varDsep & varM & varDsep & varD
                    End If
                    
                    varTmp = varTmp & vbLf & "  " & Left(strTmp2, Len(strTmp2) - 10) & strJdate
                    intK = intK + 1
                Next
                strResponse = GetMsg(Lang, 80, 2, str(intK)) & varTmp
                
                Set xUpdated = xDoc.getElementsByTagName("updated")
                varTmp = ""
                intK = 0
                For varI = 1 To xUpdated.Length
                    strTmp2 = xUpdated.Item(varI - 1).Text
                    varY = Left(Right(strTmp2, 10), 4)
                    varM = Left(Right(strTmp2, 5), 2)
                    varD = Right(strTmp2, 2)
                    If intDorder = 0 Then
                        strJdate = varM & varDsep & varD & varDsep & varY
                    ElseIf intDorder = 1 Then
                        strJdate = varD & varDsep & varM & varDsep & varY
                    Else
                        strJdate = varY & varDsep & varM & varDsep & varD
                    End If
                    
                    varTmp = varTmp & vbLf & "  " & Left(strTmp2, Len(strTmp2) - 10) & strJdate
                    intK = intK + 1
                Next
                If intK > 0 Then
                    strResponse = strResponse & vbLf & GetMsg(Lang, 80, 3, str(intK)) & varTmp
                End If
            Else
                'Application Error message found
                sendXML = -104
                varI = 0
                For varI = 1 To varXError.Length
                    If varI > 1 Then
                        strResponse = strResponse & vbLf
                    End If
                    strResponse = strResponse & varXError.Item(varI - 1).Text
                Next
            End If
        Else
            'Error loading response XML document
            sendXML = -103
        End If
    Else
        'Error loading the source XML document
        sendXML = -102
        strResponse = xDoc.parseError.reason & vbCrLf & strXML
    End If
    Exit Function
doError:
    If Err.Number <> 0 Then
        sendXML = Err.Number
        strResponse = Err.Description & Range("Import_URL").Value
    Else
        'Unknown error
        sendXML = -101
    End If
End Function

Open in new window

0
 

Author Closing Comment

by:chtullu135
ID: 38403908
Thanks for the help.
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

749 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question