访问VBA - 如何下载XML文件并将其数据输入记录集

时间:2011-08-17 10:16:09

标签: ms-access vba ms-access-2007

我从网站获取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

编辑: 显然,可以在递归调用之间传递对记录集的引用,并且记录集将保留其状态,因此可以输入逐个字段并保存记录。请参阅下面的完整解决方案。

2 个答案:

答案 0 :(得分:1)

您可以使用MSXML2.IXMLDOMNode.selectNode()通过xpath表达式显式选择节点吗?这样,您可以跟踪从外部输入的字段/记录。

答案 1 :(得分:1)

这是一个有效的解决方案。下面的方法需要在Access窗体中,它将显示XML数据。应该设置表单中的文本字段,使其'Contol source'与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