• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 700
  • Last Modified:

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

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
chtullu135
Asked:
chtullu135
  • 9
  • 3
1 Solution
 
chtullu135Author Commented:
I've been doing some more research and I think I have to replace MSXML with MSXML2 in the code
0
 
chtullu135Author Commented:
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
 
chtullu135Author Commented:
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
The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

 
chtullu135Author Commented:
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
 
aikimarkCommented:
I might suggest that you do late binding instead of early binding.  Use CreateObject() to instantiate your variables and remove the References.
0
 
chtullu135Author Commented:
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
 
aikimarkCommented:
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
 
chtullu135Author Commented:
I  see what you mean.  I'll rewrite the code using late binding using the generic and post the resulting code.
0
 
aikimarkCommented:
I still isn't clear what the problem is, unless your references mismatch the versions on the target PCs.
0
 
chtullu135Author Commented:
There isn't a problem.  I'll test it out and post the code in the event others have a similar issue
0
 
chtullu135Author Commented:
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
 
chtullu135Author Commented:
Thanks for the help.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 9
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now