xml - 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,然后将其解析为一个集合以在应用程序中使用。我发现这种方法更适合我的设置。
解决方案
问题
当前结果是有意义的,因为 Access 的 XML 迁移将节点名称呈现为列,将文本值呈现为行值,忽略任何属性。具体来说,以下格式
<table_name>
<col1>value1</col1>
<col2>value2</col2>
</table_name>
变成:
table_name
col1 col2
value1 value2
但是,因为您的 XML 响应包含两个相同的命名节点(在 XML 中是允许的)并且数据库表不能具有相同的命名列,所以只有字符串的最后一个实例被保留为列。
解决方案
要解决此问题,请在通过GET
请求下载 XML 后,考虑运行 XSLT(一种用于转换 XML 文件的专用语言)将节点转换为string1和string2:
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