如何将属性中心型XML导入Microsoft Access及批量导入方案

针对你需要将属性中心型XML导入指定Access表并批量处理的需求，提供以下三种高效方案：

方案一：Access内置导入规范+VBA批量执行 #

这是最快捷的方法，利用Access自带的XML导入向导配置规则，再用VBA批量遍历文件执行：

1. 配置单个XML导入规范
   • 提前在Access中创建好4个目标表：
     • Demographics：设置appointmentid为主键（确保无重复），添加BirthDate等对应字段
     • Scores/Items/Sections：保留appointmentid作为关联字段，添加sitecode/examcode/name28等字段
   • 点击「外部数据」>「XML文件」，选择测试用XML文件
   • 在导入向导中选择「将XML数据导入现有表中」，逐一将XML属性映射到对应表的字段，重点确认appointmentid的关联关系
   • 完成映射后保存导入规范（例如命名为XML_Import_Spec）
2. 编写VBA批量执行代码
   按Alt+F11打开VBA编辑器，插入模块后粘贴以下代码：

   Sub BatchImportXML()
       Dim fso As Object
       Dim folderPath As String
       Dim xmlFile As Object
       Dim importSpecName As String
       
       ' 替换为你的XML文件目录和导入规范名称
       folderPath = "C:\Your_XML_Folder_Path\"
       importSpecName = "XML_Import_Spec"
       
       Set fso = CreateObject("Scripting.FileSystemObject")
       
       ' 遍历目录下所有XML文件
       For Each xmlFile In fso.GetFolder(folderPath).Files
           If LCase(fso.GetExtensionName(xmlFile.Name)) = "xml" Then
               DoCmd.TransferXML acImport, , importSpecName, xmlFile.Path, False
           End If
       Next xmlFile
       
       Set xmlFile = Nothing
       Set fso = Nothing
       MsgBox "批量导入完成！"
   End Sub
   

   运行宏即可批量导入所有XML文件。

方案二：XSLT转换XML结构（解决属性中心型适配问题） #

如果之前XSLT调试失败，是因为需要将属性转换为Access兼容的节点结构，以下是适配你需求的XSLT示例：

<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
    <xsl:output method="xml" indent="yes"/>
    
    <xsl:template match="/">
        <dataroot>
            <!-- 转换Demographics属性为节点 -->
            <xsl:for-each select="Root/Demographics">
                <Demographics>
                    <appointmentid><xsl:value-of select="@appointmentid"/></appointmentid>
                    <BirthDate><xsl:value-of select="@BirthDate"/></BirthDate>
                    <!-- 添加其他Demographics字段 -->
                </Demographics>
            </xsl:for-each>
            
            <!-- 转换Scores属性为节点 -->
            <xsl:for-each select="Root/Scores">
                <Scores>
                    <appointmentid><xsl:value-of select="@appointmentid"/></appointmentid>
                    <sitecode><xsl:value-of select="@sitecode"/></sitecode>
                    <!-- 添加其他Scores字段 -->
                </Scores>
            </xsl:for-each>
            
            <!-- 转换Items属性为节点 -->
            <xsl:for-each select="Root/Items">
                <Items>
                    <appointmentid><xsl:value-of select="@appointmentid"/></appointmentid>
                    <examcode><xsl:value-of select="@examcode"/></examcode>
                    <!-- 添加其他Items字段 -->
                </Items>
            </xsl:for-each>
            
            <!-- 转换Sections属性为节点 -->
            <xsl:for-each select="Root/Sections">
                <Sections>
                    <appointmentid><xsl:value-of select="@appointmentid"/></appointmentid>
                    <name28><xsl:value-of select="@name28"/></name28>
                    <!-- 添加其他Sections字段 -->
                </Sections>
            </xsl:for-each>
        </dataroot>
    </xsl:template>
</xsl:stylesheet>

• 将上述代码保存为XML_Transform.xsl
• 批量导入时修改VBA代码，指定XSLT路径：

  DoCmd.TransferXML acImport, , , xmlFile.Path, False, "C:\Your_XSLT_File_Path\XML_Transform.xsl"
  

方案三：VBA+XMLDOM手动解析导入（最高灵活性） #

如果前两种方案仍有问题，可直接解析XML属性并写入Access表，代码示例：

Sub ImportXMLViaDOM()
    Dim dom As Object
    Dim node As Object
    Dim rsDemo As Recordset, rsScores As Recordset
    Dim rsItems As Recordset, rsSections As Recordset
    Dim folderPath As String, fso As Object, xmlFile As Object
    
    folderPath = "C:\Your_XML_Folder_Path\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set dom = CreateObject("MSXML2.DOMDocument.6.0")
    dom.async = False
    
    ' 打开目标表记录集
    Set rsDemo = CurrentDb.OpenRecordset("Demographics")
    Set rsScores = CurrentDb.OpenRecordset("Scores")
    Set rsItems = CurrentDb.OpenRecordset("Items")
    Set rsSections = CurrentDb.OpenRecordset("Sections")
    
    ' 遍历所有XML文件
    For Each xmlFile In fso.GetFolder(folderPath).Files
        If LCase(fso.GetExtensionName(xmlFile.Name)) = "xml" Then
            dom.Load xmlFile.Path
            
            ' 导入Demographics数据
            For Each node In dom.SelectNodes("//Demographics")
                rsDemo.AddNew
                rsDemo!appointmentid = node.getAttribute("appointmentid")
                rsDemo!BirthDate = CDate(node.getAttribute("BirthDate")) ' 类型转换
                rsDemo.Update
            Next node
            
            ' 导入Scores数据
            For Each node In dom.SelectNodes("//Scores")
                rsScores.AddNew
                rsScores!appointmentid = node.getAttribute("appointmentid")
                rsScores!sitecode = node.getAttribute("sitecode")
                rsScores.Update
            Next node
            
            ' 同理导入Items和Sections数据
            ' ...
        End If
    Next xmlFile
    
    ' 清理资源
    rsDemo.Close: rsScores.Close: rsItems.Close: rsSections.Close
    Set rsDemo = Nothing: Set rsScores = Nothing
    Set rsItems = Nothing: Set rsSections = Nothing
    Set dom = Nothing: Set fso = Nothing
    MsgBox "导入完成！"
End Sub

注意：根据实际字段类型调整转换逻辑，比如数字字段用CDbl()或CLng()转换。

内容的提问来源于stack exchange，提问作者amaneta