首页 > 解决方案 > Access VBA ImportXML 方法仅从 XML 文件中导入最后一条记录

问题描述

我正在尝试使用 Application.ImportXML 方法将一个非常基本的 XML 文件导入 MS Access (2010)。当我查看导入结果时,该表仅包含 XML 文件中的最后一条记录。

对于初学者 - 我在 Visual Studio 2017 中创建了一个小型 ASP.NET Web 应用程序 (VB.NET),它有一个 Controller PersonController.vb。我已经单独保留了默认方法,并且设置了当前值 -

Public Function GetValues() As IEnumerable(Of String)
    Return New String() {"Person1", "Person2"}
End Function

当我运行它时,IIS Express (Google Chrome)我可以通过 Postmaster 查看 XML 结果,如下所示 -

["Person1","Person2"]

或者如果我选择 json -

[
    "Person1",
    "Person2"
]

我选择 XML。

所以现在到我的Access VBA。我创建了一个新模块来测试将 XML 导入本地访问表 -

Option Compare Database
Option Explicit

Private Const URL As String = "http://localhost:58372/api/Person"
Private Const path As String = "C:/Users/my.name/Desktop/"

Public Enum RequestReadyState
    UNINITIALISED = 0
    LOADING
    LOADED
    INTERACTIVE
    COMPLETED
End Enum

当我手动转到时,http://localhost:58372/api/Person/我得到了所需的输出。我在 VBA 方面遇到了一些问题。

注意 - 我Microsoft XML, v6.0为此添加了对库的引用

Public Sub Readxml()
    Dim reader As New XMLHTTP60, doc As MSXML2.DOMDocument60

    With reader
    ' open the object
        .Open "GET", URL, False
        .setRequestHeader "Accept", "application/xml"
    ' send the command specified in the open
        .send

    ' wait until the request is complete, 4 is the completed state
    ' see (https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms753800(v=vs.85))
        Do Until .ReadyState = RequestReadyState.COMPLETED
            DoEvents
        Loop

        ' check if we encountered an error
        ' status codes (https://en.wikipedia.org/wiki/List_of_HTTP_status_codes)
        If .Status = 200 Then
            ' it worked
            Set doc = .responseXML
            doc.Save path & "Person.xml"
            Application.ImportXML path & "Person.xml", acStructureAndData
        Else
            ' it didn't
            MsgBox "It broke: " & .Status & " : " & .statusText
            Exit Sub
        End If
    End With

' clean up
    Set reader = Nothing
    If Not doc Is Nothing Then Set doc = Nothing
    Kill path & "Person.xml"
End Sub

子运行完成而没有任何错误,但是当我打开新创建的表ArrayOfstring时,它只包含 1 条记录,即“Person2”。

我试过解决这个问题,但我迷路了。doc.childNodes.length返回 1(应该是 2 条记录?)但我不明白为什么。

我已使用此 XML 验证站点尝试并帮助我了解生成的 XML 是否存在问题,当我勾选针对外部 XML 模式进行验证的选项时,它给了我以下错误 -

cvc-elt.1: Cannot find the declaration of element 'ArrayOfstring'.

XML 文件内容 -

<ArrayOfstring xmlns:i="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://schemas.microsoft.com/2003/10/Serialization/Arrays">
  <string>Person1</string>
  <string>Person2</string>
</ArrayOfstring>`

谁能指出我正确的方向/发现我在这里错过的明显东西?对不起,如果我有点啰嗦,只是对这整件事有点困惑。

编辑:我已经更新了参考以使用 Microsoft XML、v3.0 并更新了对象类型以反映新的参考,但我仍然遇到同样的问题。

Edit2:更新:下面的答案说明转换为不同类型的 XML 确实有效,但是我选择使用不同的解决方案。为了避免使用本地表,我将标头请求设置为使用 JSON,然后将其解析为一个集合以在应用程序中使用。我发现这种方法更适合我的设置。

标签: xmlms-accessasp.net-web-apivba

解决方案


问题

当前结果是有意义的,因为 Access 的 XML 迁移将节点名称呈现为列,将文本值呈现为行值,忽略任何属性。具体来说,以下格式

<table_name>
  <col1>value1</col1>
  <col2>value2</col2>
</table_name>

变成:

table_name

  col1    col2
value1  value2

但是,因为您的 XML 响应包含两个相同的命名节点(在 XML 中是允许的)并且数据库表不能具有相同的命名列,所以只有字符串的最后一个实例被保留为列。

解决方案

要解决此问题,请在通过GET请求下载 XML 后,考虑运行 XSLT(一种用于转换 XML 文件的专用语言)将节点转换为string1string2

XSLT (另存为 .xsl 文件,特殊的 .xml 文件)

<?xml version="1.0" encoding="utf-8"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform" 
                              xmlns:doc="http://schemas.microsoft.com/2003/10/Serialization/Arrays">

  <xsl:output method="xml" indent="yes" />

  <xsl:template match="/doc:ArrayOfstring">
    <xsl:copy>
        <xsl:apply-templates select="doc:string"/>
    </xsl:copy>
  </xsl:template>

  <xsl:template match="doc:string">
    <xsl:element name="{concat(local-name(), position())}" 
                 namespace="http://schemas.microsoft.com/2003/10/Serialization/Arrays"> 
        <xsl:value-of select="." />
    </xsl:element>
  </xsl:template>

</xsl:stylesheet>

VBA

Public Sub XMLResposeTransform()

On Error GoTo ErrHandle
    ' ADD MSXML, v6.0 REFERENCE UNDER TOOLS
    Dim xmlDoc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60

    ' LOAD XML AND XSL FILES
    xmlDoc.async = False
    xmlDoc.Load "Input.xml"

    xslDoc.async = False
    xslDoc.Load "XSLT_Script.xsl"

    ' TRANSFORM XML
    xmlDoc.transformNodeToObject xslDoc, newDoc
    newDoc.Save "Output.xml"

    Application.ImportXML "Output.xml", acStructureAndData

    MsgBox "Successfully imported the transformed XML!", vbInformation

ExitHandle:
    Set xmlDoc = Nothing: Set xslDoc = Nothing: Set newDoc = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbInformation
    Resume ExitHandle

End Sub

XML 输出

<?xml version="1.0" encoding="UTF-16"?>
<ArrayOfstring xmlns:i="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://schemas.microsoft.com/2003/10/Serialization/Arrays">
    <string1>Person1</string1>
    <string2>Person2</string2>
</ArrayOfstring>

访问表

ArrayOfstring

string1    string2
Person1    Person2

如果您的 XML 文件有多个重复子元素,那么会传播多行:

假设的 XML

<?xml version="1.0" encoding="UTF-16"?>
<ArrayOfstring xmlns:i="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://schemas.microsoft.com/2003/10/Serialization/Arrays">
  <newtable>
    <string1>Person1</string1>
    <string2>Person2</string2>
  </newtable>
  <newtable>
    <string1>Person1</string1>
    <string2>Person2</string2>
  </newtable>
  <newtable>
    <string1>Person1</string1>
    <string2>Person2</string2>
  </newtable>
</ArrayOfstring>

访问表

newtable

string1    string2
Person1    Person2
Person1    Person2
Person1    Person2

推荐阅读