我有一堆(平面)XML文件,例如:
<?xml version="1.0" encoding="UTF-8"?>
<SomeName>
<UID>
ID123
</UID>
<Node1>
DataA
</Node1>
<Node2>
DataB
</Node2>
<Node3>
DataC
</Node3>
<AnotherNode1>
DataD
</AnotherNode1>
<AnotherNode2>
DataE
</AnotherNode2>
<AnotherNode3>
DataF
</AnotherNode3>
<SingleNode>
DataG
</SingleNode>
</SomeName>
现在我的实际XML文件有太多节点,因此无法将它们导入到单个表中(由于255列限制),因此我需要将数据拆分为多个表。我已经手工创建了表,所以现在所有访问都必须将Node名称与每个表中的列匹配并复制数据。
它仅对一个名为“SomeName”的表执行此操作,但不保留所有其他表。
我不确定如何访问将我的XML文件正确导入到所有表中。我也尝试在每个表中创建UID字段并将它们链接起来(因为UID对每个XML数据集都是唯一的),但这也使得访问权限不受影响。
我试图找到关于这个问题的任何信息,但迄今为止一无所获。
我非常感谢任何帮助或指示。
答案 0 :(得分:5)
由于您需要超过255个字段,因此您必须使用代码执行此操作。您可以将XML加载到MSXML2.DOMDocument
,收集节点值的子集,构建INSERT
语句并执行它。
这是我针对您的示例数据测试的过程。这很难看,但它确实有效。修改CurrentDb.Execute
,strTagList
,strFieldList
和strTable
后,取消对cintNumTables
行的评论,并查看INSERT
语句。如果要加载的表超过2个,请添加其他Case
块。
Public Sub Grinner(ByRef pURL As String)
Const cintNumTables As Integer = 2
Dim intInnerLoop As Integer
Dim intOuterLoop As Integer
Dim objDoc As Object
Dim objNode As Object
Dim strFieldList As String
Dim strMsg As String
Dim strSql As String
Dim strTable As String
Dim strTag As String
Dim strTagList As String
Dim strUID As String
Dim strValueList As String
Dim varTags As Variant
On Error GoTo ErrorHandler
Set objDoc = GetXMLDoc(pURL)
Set objNode = objDoc.getElementsByTagName("UID").Item(0)
strUID = objNode.Text
For intOuterLoop = 1 To cintNumTables
Select Case intOuterLoop
Case 1
strTable = "Table1"
strTagList = "Node1,Node2,Node3,AnotherNode1"
strFieldList = "UID, N1, N2, N3, A1"
Case 2
strTable = "Table2"
strTagList = "AnotherNode2,AnotherNode3,SingleNode"
strFieldList = "UID, A2, A3, SN"
Case Else
'oops!
strTable = vbNullString
End Select
If Len(strTable) > 0 Then
varTags = Split(strTagList, ",")
strValueList = "'" & strUID & "'"
For intInnerLoop = 0 To UBound(varTags)
strTag = varTags(intInnerLoop)
Set objNode = objDoc.getElementsByTagName(strTag).Item(0)
strValueList = strValueList & ", '" & _
Replace(objNode.Text, "'", "''") & "'"
Next intInnerLoop
strSql = "INSERT INTO " & strTable & " (" & _
strFieldList & ")" & vbNewLine & _
"VALUES (" & strValueList & ");"
Debug.Print strSql
'CurrentDb.Execute strSql, dbFailOnError
End If
Next intOuterLoop
ExitHere:
Set objNode = Nothing
Set objDoc = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure Grinner"
MsgBox strMsg
GoTo ExitHere
End Sub
Public Function GetXMLDoc(pURL) As Object
' early binding requires reference, Microsoft XML
'Dim objDoc As MSXML2.DOMDocument30
'Dim objParseErr As MSXML2.IXMLDOMParseError
'Set objDoc = New MSXML2.DOMDocument30
' late binding; reference not required
Dim objDoc As Object
Dim objParseErr As Object
Dim strMsg As String
On Error GoTo ErrorHandler
Set objDoc = CreateObject("Msxml2.DOMDocument.3.0")
objDoc.async = False
objDoc.validateOnParse = True
objDoc.Load pURL
If (objDoc.parseError.errorCode <> 0) Then
Set objParseErr = objDoc.parseError
MsgBox ("You have error " & objParseErr.reason)
Set objDoc = Nothing
End If
ExitHere:
Set objParseErr = Nothing
Set GetXMLDoc = objDoc
On Error GoTo 0
Exit Function
ErrorHandler:
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure GetXMLDoc"
MsgBox strMsg
Set objDoc = Nothing
GoTo ExitHere
End Function
以下是我发现对VBA / XML / DOM有用的4个链接: