Access VBA - how to download XML file and enter its data into a recordset

狂风中的少年 提交于 2019-11-28 02:16:01

问题


I get an XML from website into a string strXML. Then I create an XML DOM document:

    Dim xmlDoc As MSXML2.DOMDocument
    Dim xmlElement As MSXML2.IXMLDOMElement
    Dim xmlNode As MSXML2.IXMLDOMElement

    Set xmlDoc = New MSXML2.DOMDocument

    xmlDoc.loadXML (strXML)
    DisplayNode xmlDoc.childNodes

Now the DisplayNode is a recursive method which calls itself for every line in the XML data:

Public Sub DisplayNode(ByRef Nodes As MSXML2.IXMLDOMNodeList)
Dim xNode As MSXML2.IXMLDOMNode

For Each xNode In Nodes
  If xNode.nodeType = NODE_TEXT Then
    Debug.Print xNode.parentNode.nodeName & " = " & xNode.nodeValue
  Else
    If xNode.parentNode.nodeName = "data" Then Debug.Print "*** NEW RECORD ***"
  End If

  If xNode.hasChildNodes Then
     DisplayNode xNode.childNodes
     Debug.Print "> recursive call - next field<"
  End If

Next xNode

End Sub

The problem here is how to enter the XML data from a recursive loop into a recordest. If it was just a normal loop it would be easy, but a recursive loop cannot keep a truck of which field and which record is being entered as it is continuously passing its parameters.

One way that I can see to do it at the moment is to create a collection of objects which contain two strings. I could add all data nodes to this collection and then use a loop to move data from the collection into a recordset.

However, I wonder if it is possible to read XML string without using a recursive method just plain loops, or perhaps there is a different way of loading a custom XML file/string into a recordset.

This is the output of DisplayNode:

*** NEW RECORD***
EVENTID = 75098
> recursive call <
DESCRIPTION = Pack
> recursive call <
NAME = John Smith
> recursive call <
CUSTOMERID = 37684
> recursive call <
TRADER = MY COMPANY
> recursive call <
ADDRESS = Flat A
SOUTHILL PARK
LONDON
> recursive call <
> recursive call <
*** NEW RECORD***
.
.
.
repeats

EDIT: Apparently it is possible to pass a reference to a recordset between the recursive calls and the recordset will preserve its state so one by one field can be entered and the record saved. See the full solution below.


回答1:


You could use MSXML2.IXMLDOMNode.selectNode() to explicitly select nodes via xpath expressions? This way, you keep track of which fields/records are entered from outside.




回答2:


Here is a working solution. The method below needs to be in the Access Form which will display the XML data. The text fields in the form should be set that their 'Contol source' has the same names as the fields addedd in the ADODB recordset.

Private Sub GetXMLdata()
 On Error GoTo ErrorHandler

'************************************************************
'CREATE AN ADODB RECORDSET - this recordset is in memory only it does not create a table in the database file
'This requires a reference addedd in TOOLS > References, Microsfot ActiveX Data Object , the latest version...
'************************************************************

 Dim rs As ADODB.Recordset
 Dim fld As ADODB.field
 Dim strXML As String


    Set rs = New ADODB.Recordset
    With rs
        .Fields.Append "EventID", adVarChar, 15, adFldMayBeNull
        .Fields.Append "JobDescription", adVarChar, 255, adFldMayBeNull
        .Fields.Append "FullName", adVarChar, 100, adFldMayBeNull
        .Fields.Append "CustomerID", adVarChar, 15, adFldMayBeNull
        .Fields.Append "CustomerAddress", adVarChar, 255, adFldMayBeNull
        .Fields.Append "Town", adVarChar, 64, adFldMayBeNull
        .Fields.Append "PostCode", adVarChar, 20, adFldMayBeNull
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
    End With

'**********************************************************
'DOWNLOAD XML DATA 
'**********************************************************


    Dim obj As MSXML2.ServerXMLHTTP
    Set obj = New MSXML2.ServerXMLHTTP

    bj.Open "GET", "http://www.myserver.com/mydata.xml", False
    'in case you are sending a form *POST* or XML data to a SOAP server set content type
    obj.setRequestHeader "Content-Type", "text/xml"    
    obj.send

    Dim status As Integer
    status = obj.status

    If status >= 400 And status <= 599 Then
        Debug.Print "Error Occurred : " & obj.status & " - " & obj.statusText
    End If


   '********************************************************** 
   'CREATE XML DOM DOCUMENT  
   '**********************************************************   

    Dim xmlDoc As MSXML2.DOMDocument
    Dim xmlElement As MSXML2.IXMLDOMElement
    Dim xmlNode As MSXML2.IXMLDOMElement

    Set xmlDoc = New MSXML2.DOMDocument

    xmlDoc.loadXML (obj.responseText)


'**********************************************************
'LOAD XML DATA INTO THE RECORDSET 
'********************************************************** 

    LoadNodesIntoRs xmlDoc.childNodes, rs, 0

    If rs.recordCount > 0 Then

        rs.Update

    'BOUND THIS RECORDSET TO THE FORM
        Set Me.Recordset = rs

        End If

    Exit Sub


ErrorHandler:

    MsgBox Err.Description

End Sub

The method below enters one by one field into the passed recordset. Because MSXML2 seems to skip empty tags like <something></something> each tag name with data needs to be checked by name and entered into an appropriate recordset field.

Public Sub LoadNodesIntoRs(ByRef nodes As MSXML2.IXMLDOMNodeList, rs As ADODB.Recordset, recordCount As Integer)
    Dim xNode As MSXML2.IXMLDOMNode
    Dim fieldIndex As Integer

    For Each xNode In nodes
        If xNode.nodeType = NODE_TEXT Then
            'a field - actual data
        'note that MSXML2 will skip any node which contain no data like <COMPANY></COMPANY>

            Select Case xNode.parentNode.nodeName
                Case "EVENTID"
                    fieldIndex = 0
                Case "DESCRIPTION"
                    fieldIndex = 1
                Case "NAME"
                    fieldIndex = 2
                Case "CUSTOMERID"
                    fieldIndex = 3
                Case "ADDRESS"
                    fieldIndex = 4
                Case "TOWN"
                    fieldIndex = 5
                Case "POSTALCODE"
                    fieldIndex = 6
            End Select

            rs(fieldIndex) = xNode.nodeValue


        Else

            'CHECK FOR THE NODE WHICH CONTAINS THE SETS OF DATA'
            If xNode.parentNode.nodeName = "data" Then
                'next record
                If recordCount > 0 Then
                    'save previous record
                    rs.Update
                    fieldIndex = 0
                End If
                rs.AddNew
                recordCount = recordCount + 1
            End If


        End If

        If xNode.hasChildNodes Then
           'recurive call for the next node 
          LoadNodesIntoRs xNode.childNodes, rs, recordCount
        End If

    Next xNode

End Sub


来源:https://stackoverflow.com/questions/7091162/access-vba-how-to-download-xml-file-and-enter-its-data-into-a-recordset

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!