[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 987
  • Last Modified:

Having trouble creating user defined data type

Hello,

I've inherited an application that I need to complete.  I was getting an error that xDoc is not defined, so I tried creating the following user defined type at the top of the module.  It's not correct so I am trying to figure out what is wrong.  Thanks

Type MSXML

      Dim DOMDocument as DOMDocument
      Dim XMLHTTPRequest as XMLHTTPRequest
 

End Type

'=========================================
'  Post and Send billing data over the web
'=========================================
Private Function sendXML(strXML, strResponse, strURL As String) As Long
Dim xDoc As MSXML.DOMDocument
Dim xHTTP As MSXML.XMLHTTPRequest
'Dim xError, xImported, xUpdated As MSXML.IXMLDOMElement
Dim xError, xImported, xUpdated As MSXML.IXMLDOMNodeList
Dim tmp, tmp2 As String
Dim StatusNum As Long
Dim i, k As Integer
Dim Y, M, D, Dsep, Jdate As String
Dim Dorder 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
            Dsep = Application.International(xlDateSeparator)
            Dorder = Application.International(xlDateOrder)
            'xlDateOrder (0=MDY, 1=DMY, 2=YMD)
            Set xError = xDoc.getElementsByTagName("error")
            strResponse = ""
            If xError.Length = 0 Then
                sendXML = 0
                Set xImported = xDoc.getElementsByTagName("imported")
                tmp = ""
                k = 0
    
                For i = 1 To xImported.Length
                    tmp2 = xImported.Item(i - 1).Text
                    Y = Left(Right(tmp2, 10), 4)
                    M = Left(Right(tmp2, 5), 2)
                    D = Right(tmp2, 2)
                    If Dorder = 0 Then
                        Jdate = M & Dsep & D & Dsep & Y
                    ElseIf Dorder = 1 Then
                        Jdate = D & Dsep & M & Dsep & Y
                    Else
                        Jdate = Y & Dsep & M & Dsep & D
                    End If
                    
                    tmp = tmp & vbLf & "  " & Left(tmp2, Len(tmp2) - 10) & Jdate
                    k = k + 1
                Next
                strResponse = GetMsg(Lang, 80, 2, str(k)) & tmp
                
                Set xUpdated = xDoc.getElementsByTagName("updated")
                tmp = ""
                k = 0
                For i = 1 To xUpdated.Length
                    tmp2 = xUpdated.Item(i - 1).Text
                    Y = Left(Right(tmp2, 10), 4)
                    M = Left(Right(tmp2, 5), 2)
                    D = Right(tmp2, 2)
                    If Dorder = 0 Then
                        Jdate = M & Dsep & D & Dsep & Y
                    ElseIf Dorder = 1 Then
                        Jdate = D & Dsep & M & Dsep & Y
                    Else
                        Jdate = Y & Dsep & M & Dsep & D
                    End If
                    
                    tmp = tmp & vbLf & "  " & Left(tmp2, Len(tmp2) - 10) & Jdate
                    k = k + 1
                Next
                If k > 0 Then
                    strResponse = strResponse & vbLf & GetMsg(Lang, 80, 3, str(k)) & tmp
                End If
            Else
                'Application Error message found
                sendXML = -104
                i = 0
                For i = 1 To xError.Length
                    If i > 1 Then
                        strResponse = strResponse & vbLf
                    End If
                    strResponse = strResponse & xError.Item(i - 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
  • 3
  • 3
1 Solution
 
Martin LissRetired ProgrammerCommented:
I'm sure it's not what's causing your problem, so just an FYI that when you do something like the following, only xUpdated is defined as a MSXML.IXMLDOMNodeList; the rest are defined as Variants.

Dim xError, xImported, xUpdated As MSXML.IXMLDOMNodeList

So you need to define them separately or like this if you want them to be MSXML.IXMLDOMNodeLists

Dim xError  As MSXML.IXMLDOMNodeList, xImported  As MSXML.IXMLDOMNodeList, xUpdated As MSXML.IXMLDOMNodeList
0
 
chtullu135Author Commented:
Never mind.  I figured it out.  I added Microsoft XML version 2.0 to the references
0
 
Martin LissRetired ProgrammerCommented:
Microsoft XML version 2.0 is very old. You should use at least Microsoft XML version 4.0
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
NorieCommented:
You are missing a reference, I think it's Microsoft XML v2.0.
0
 
NorieCommented:
Martin

The code doesn't compile with V3.0 or later, not when I tried anyway.
0
 
Martin LissRetired ProgrammerCommented:
Okay then my suggestion (when you have time) would be to change the code so that it works in 3.0 or 4.0. Note that you can prObably find documentation on what's causing the problems (or ask in another question).
0
 
NorieCommented:
I think that can be done, or at least started, by changing MSXML to MSXML2 and XMLHTTPRequest to XMLHTTP.
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

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