Доступ к VBA - как скачать файл XML и ввести его данные в набор записей

Question

Я получаю XML с веб-сайта в строку strXML.Затем я создаю документ XML DOM:

    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

Теперь DisplayNode - это рекурсивный метод, который вызывает себя для каждой строки в данных XML:

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

Проблема здесь состоит в том, как ввести данные XML из рекурсивного цикла в запись.Если бы это был просто нормальный цикл, это было бы легко, но рекурсивный цикл не мог бы определить, какое поле и какую запись вводить, поскольку он непрерывно передает свои параметры.

Один из способов сделать это на данный момент - создать коллекцию объектов, содержащих две строки.Я мог бы добавить все узлы данных в эту коллекцию, а затем использовать цикл для перемещения данных из коллекции в набор записей.

Однако мне интересно, возможно ли прочитать строку XML без использования рекурсивного метода, просто простые циклыили, возможно, существует другой способ загрузки пользовательского XML-файла / строки в набор записей.

Это вывод 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: очевидно, можно передать ссылку на набор записей между рекурсивными вызовами, и набор записей сохранит свое состояние, так что один за другимполе может быть введено и запись сохранена.Смотрите полное решение ниже.

Answer 1

Вот рабочее решение. Метод ниже должен быть в форме доступа, которая будет отображать данные XML. Текстовые поля в форме должны быть установлены так, чтобы их «источник Contol» имел те же имена, что и поля, добавленные в набор записей ADODB.

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

Приведенный ниже метод вводит одно за другим поле в переданный набор записей. Поскольку MSXML2, кажется, пропускает пустые теги, такие как <something></something>, каждое имя тега с данными необходимо проверять по имени и вводить в соответствующее поле набора записей.

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

Answer 2

Вы могли бы использовать MSXML2.IXMLDOMNode.selectNode() для явного выбора узлов с помощью выражений xpath? Таким образом, вы отслеживаете, какие поля / записи вводятся извне.