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

Posted 2023-05-06

【中文标题】将 XML 文件导入具有多个表的 Access DB

【英文标题】：Importing XML files into an Access DB with multiple tables

【发布时间】：2010-08-02 12:10:44

【问题描述】：

我有一堆（平面）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 列的限制），所以我需要将数据拆分为多个表。我已经手动创建了表，所以现在所有访问都要做的就是将节点名称与每个表中的列匹配并复制数据。

它只对一个名为“SomeName”的表这样做，而其他所有表都保持不变。

我不确定如何获得将我的 XML 文件正确导入所有表的权限。我也已经尝试在每个表中创建 UID 字段并将它们链接起来（因为 UID 对每个 XML 数据集都是唯一的），但这也没有给访问留下深刻的印象。

我试图找到有关此问题的任何信息，但到目前为止一无所获。

我将非常感谢任何帮助或指点。

【问题讨论】：

是否有不能将整个 XML 导入单个列的原因？长文之类的？

你的意思是转置数据吗？如果是这样，那也无济于事，因为我有 1,5k+ 文件必须导入，并且列限制也将适用。此外，我不确定如何将 xml 导入单个列。在导入 xml 数据时，我只需要访问将我的多个表视为一个表。一定有什么办法……

这是一次性的吗？您是否可以选择以编程方式或手动方式编辑文件？

是的，这只是一个工作。以编程方式编辑文件将是一个明确的选择。手动不（超过 1,5k 个文件：D）

列出每个表的表名和最后一个节点并基于此信息（文件系统对象）以编程方式将表名作为附加节点插入并不难。然后可以使用 Application.ImportXML 和 acAppendData 导入文件。

【参考方案1】：

由于您需要超过 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

【讨论】：

感谢您的广泛回答。不幸的是，我从未使用过 VB 或一般的 DOM……我现在正在研究这些东西。我希望我能让你的解决方案奏效。您是否有任何指示让我开始使用所有这些 VB 和 DOM 的东西以供访问？谢谢。

我也是新手。我添加了 4 个我觉得有用的链接。