访问VBA-如何下载XML文件并将其数据输入记录集 [英] Access VBA - how to download XML file and enter its data into a recordset
问题描述
我从网站将XML转换为字符串strXML. 然后创建一个XML DOM文档:
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
现在 DisplayNode 是一种递归方法，它为XML数据中的每一行调用自身:
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
这里的问题是如何将XML数据从递归循环输入到记录中.如果这只是一个普通的循环，那将很容易，但是递归循环无法在连续传递其参数的同时保持卡车输入哪个字段和哪个记录.
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.
但是，我想知道是否可以仅通过普通循环而不使用递归方法来读取XML字符串，或者是否存在将自定义XML文件/字符串加载到记录集中的另一种方法.
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.
这是DisplayNode的输出:
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
显然，可以在递归调用之间传递对记录集的引用，并且记录集将保留其状态，以便可以输入一个字段并保存记录.请参阅下面的完整解决方案.
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.
推荐答案
这是一个可行的解决方案.下面的方法需要在访问表单中，该表单将显示XML数据.表单中的文本字段应设置为其"Contol源"具有与ADODB记录集中添加的字段相同的名称.
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
下面的方法在传递的记录集中一一输入字段.因为MSXML2似乎跳过了<something></something>之类的空标签，所以每个带有数据的标签名称都需要按名称进行检查，并输入到适当的记录集字段中.
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
这篇关于访问VBA-如何下载XML文件并将其数据输入记录集的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
