将XML文件导入具有多个表的Access DB

发布时间：2020-12-16 07:51:56 所属栏目：百科来源：网络整理

导读：我有一堆(平面) 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 /Anothe

我有一堆(平面) 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数据集都是唯一的),但这也使得访问权限不受影响.

我试图找到关于这个问题的任何信息,但迄今为止一无所获.

我非常感谢任何帮助或指示.

由于您需要超过255个字段,因此您必须使用代码执行此操作.您可以将XML加载到MSXML2.DOMDocument中,收集节点值的子集,构建INSERT语句并执行它.

这是我针对您的示例数据测试的过程.这很难看,但它确实有效.修改strTagList,strFieldList,strTable和cintNumTables后取消注释CurrentDb.Execute行并查看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个链接：

> Google: vba xml dom
> msdn: A Beginner’s Guide to the XML DOM
> msdn: Use the XML Object Model
> Stack Overflow: How to parse XML in VBA

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!