读取（太多？）大 xml 文件
Reading (too?) large xml-file
我需要使用 xml 文件中的一些数据，该文件的大小约为 > 2 GB（您可以查看：https://leidata.gleif.org/api/v1/concatenated-files/lei2/20180128/zip）
我需要访问中的数据并尝试使用以下 vba-代码读取文件：
Public Function ReadLei(strFile As String) As Long
Dim xmlLeiData As New MSXML2.DOMDocument
With xmlLeiData
.async = False
.preserveWhiteSpace = False
.validateOnParse = False
.resolveExternals = False
End With
If xmlLeiData.Load(strFile) = True Then
MsgBox "ok"
Else
MsgBox xmlLeiData.parseError
End If
ReadLei = 0
End Function
它以 0x8007000E 内存不足错误结束。
是否有其他方法可以通过 vba/Access 读取和解析如此大的 XML 文件？
我不知道在 VBA / Access 下具体可以做什么，但是为这个大小的输入构建一个 DOM 可能是不可行的。
MSXML 解析器（您正在使用）也有一个 SAX api，解析器在其中读取输入文件并通知应用程序开始标记、结束标记、属性和文本节点等事件。这可能会满足您的需求，但编程可能会很棘手。
Microsoft 的 .NET 解析器 (System.Xml) 也有一个 "pull" API，允许应用程序调用解析器提供的 "nextEvent()" 方法，因此您可以以结构化的方式阅读文件。许多人发现这比 SAX 方法更容易使用，尽管它仍然是非常低级的编码。
一种完全不同的方法是使用流式 XSLT 3.0（可能在转换中将文件减小到可管理的大小，然后您可以使用 DOM 以您习惯的方式访问）。为此，您需要 Saxon 的商业版本。它会花费更多，但可以节省您的时间。
更新：您在评论中说该文件包含 1m 条记录，而您只想保留 4 或 5 列。您可以在流式 XSLT 3.0 转换中像这样缩减文件，其中 P、Q、R 和 S 是需要的列：
<xsl:transform version="3.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:mode streamable="yes" on-no-match="deep-skip"/>
<xsl:template match="/*">
<xsl:copy>
<xsl:apply-templates select="*"/>
</xsl:copy>
</xsl:template>
<xsl:template match="P|Q|R|S">
<xsl:copy-of select="."/>
</xsl:template>
</xsl:transform>
因为你没有提供细节，我不能给你细节。
您可以先使用 xslt 文件和 Application.TransformXML 方法 (documentation), and then import the XML using the Application.ImportXML method (documentation) 将 XML 转换为只包含您想要的数据。
请注意，Access 数据库的最大大小为 2GB。导入大文件很快就会超过此限制。
感谢您提供（巨大的）样本文件。我处理 xml 文件已经超过 15 年了。我一直怀疑 Ms Access 在接近 GB 限制时的表现如何。
根据我的经验，现在确认只有一位获胜者：
Open FileURL For Input As #FileNum。与 InputLine = Input(1000, #FileNum) ' read some 1.000 characters 组合。基本上，只需将 XML 视为纯文本文件即可。
如果可以使用 Line Input 代替 Input，编码会更容易，但在您的示例中情况并非如此。您的示例文件使用 vbLf 标记文本中一行的结尾，Line Input 需要 vbCrLf 才能正常工作。
我最终得到了一个小应用程序，它首先扫描文件以查找不同的出现标签。之后，这些标签可以分配给几个任务：
- 将值分配给 table
中的字段
- 跳过值
- 亲子-table
在第二次完整读取中，所有值都分配给它们在数据库中的目标字段。
我将尝试通过插入一些代码来澄清一下 (as of 02 Feb 2018 15h London time, I have to dash, I am gonna come back to it at a later point of time)
Option Compare Database
Option Explicit
Dim marrKnownTags() As String
Public Sub ReadFile2GB()
Dim FileNum As Integer
Dim InputLine As String
Call init_marrKnownTags
FileNum = FreeFile
Open "X:180128-gleif-concatenated-file-lei2.xml" For Input As #FileNum
Do While Not EOF(FileNum)
InputLine = Input(99000, #FileNum) ' read some 99.000 characters
Call processTemporaryBlock(InputLine)
...
Loop
Close #FileNum
End Sub
Public Function positionCrOfLf(PieceToScan As String) As Long
Dim Pos As Long
Pos = 0
If Pos = 0 Then
Pos = InStr(PieceToScan, vbCrLf)
End If
If Pos = 0 Then
Pos = InStr(PieceToScan, vbLf)
End If
If Pos = 0 Then
Pos = InStr(PieceToScan, vbCr)
End If
'Debug.Print "fie positionCrOfLf := " & Pos
positionCrOfLf = Pos
End Function
Private Sub init_marrKnownTags()
ReDim Preserve marrKnownTags(333)
marrKnownTags(1) = "<?xml version=" ' start of xml
marrKnownTags(10) = "<lei:LEIData" ' Table_01 Open
marrKnownTags(20) = "<lei:LEIHeader>" ' Table_02 Open
marrKnownTags(21) = "<lei:ContentDate>" ' field
marrKnownTags(22) = "<lei:FileContent>" ' field
marrKnownTags(23) = "<lei:RecordCount>" ' field
marrKnownTags(30) = "<lei:Extension>" ' Table_03 Open
marrKnownTags(40) = "<gleif:Sources>" ' Table_04 Open
marrKnownTags(41) = "<gleif:Source>" ' addnew record Table_04
marrKnownTags(42) = "<gleif:ContentDate>" ' field
marrKnownTags(43) = "<gleif:Originator>" ' field
marrKnownTags(44) = "<gleif:RecordCount>" ' field
marrKnownTags(45) = "</gleif:Source>" ' save this new record Table_04
marrKnownTags(46) = "</gleif:Sources>" ' Table_04 Close
marrKnownTags(31) = "</lei:Extension>" ' Table_03 Close
' ... some more child-tables in the future ??
marrKnownTags(129) = "</lei:Entity>" ' Table_12 Close ' close child table
marrKnownTags(140) = "<lei:Registration>" ' Table_14 Open
marrKnownTags(141) = "<lei:LastUpdateDate>" ' DO NOT SKIP field with "2017-11-30T15:06:27Z" =?= 2017-11-30 15:06:27
marrKnownTags(142) = "<lei:RegistrationStatus>" ' DO NOT SKIP field with "ISSUED"
marrKnownTags(149) = "</lei:Registration>" ' Table_14 Close
marrKnownTags(2) = "</lei:LEIRecord>" ' save this new record
marrKnownTags(2) = "</lei:LEIRecords>" ' Table_11 Close ' close child table
End Sub
Public Function processTemporaryBlock(ByVal TemporaryBlock As String)
Dim positionStart As Long, positionEnd As Long, positionLength As Long
Dim OneLine As String, searchTag As String
Dim indexArray As Long
Dim tagFoundYN As Boolean
positionStart = 1
positionEnd = positionCrOfLf(TemporaryBlock)
Do While positionEnd > 0
OneLine = trim(Mid(TemporaryBlock, positionStart, positionEnd - 1))
Debug.Print "OneLine := " & OneLine
tagFoundYN = False
For indexArray = LBound(marrKnownTags) To UBound(marrKnownTags)
searchTag = marrKnownTags(indexArray)
searchTag = Trim(searchTag)
If searchTag = "" Then
' skip
Else
If Left(OneLine, Len(searchTag)) = searchTag Then
' Call processTag(OneLine)
tagFoundYN = True
exit for
End If
End If
Next
positionStart = positionStart + positionEnd
positionEnd = positionCrOfLf(Mid(TemporaryBlock, positionStart))
Loop
End Sub
我需要使用 xml 文件中的一些数据，该文件的大小约为 > 2 GB（您可以查看：https://leidata.gleif.org/api/v1/concatenated-files/lei2/20180128/zip）
我需要访问中的数据并尝试使用以下 vba-代码读取文件：
Public Function ReadLei(strFile As String) As Long
Dim xmlLeiData As New MSXML2.DOMDocument
With xmlLeiData
.async = False
.preserveWhiteSpace = False
.validateOnParse = False
.resolveExternals = False
End With
If xmlLeiData.Load(strFile) = True Then
MsgBox "ok"
Else
MsgBox xmlLeiData.parseError
End If
ReadLei = 0
End Function
它以 0x8007000E 内存不足错误结束。
是否有其他方法可以通过 vba/Access 读取和解析如此大的 XML 文件？
我不知道在 VBA / Access 下具体可以做什么，但是为这个大小的输入构建一个 DOM 可能是不可行的。
MSXML 解析器（您正在使用）也有一个 SAX api，解析器在其中读取输入文件并通知应用程序开始标记、结束标记、属性和文本节点等事件。这可能会满足您的需求，但编程可能会很棘手。
Microsoft 的 .NET 解析器 (System.Xml) 也有一个 "pull" API，允许应用程序调用解析器提供的 "nextEvent()" 方法，因此您可以以结构化的方式阅读文件。许多人发现这比 SAX 方法更容易使用，尽管它仍然是非常低级的编码。
一种完全不同的方法是使用流式 XSLT 3.0（可能在转换中将文件减小到可管理的大小，然后您可以使用 DOM 以您习惯的方式访问）。为此，您需要 Saxon 的商业版本。它会花费更多，但可以节省您的时间。
更新：您在评论中说该文件包含 1m 条记录，而您只想保留 4 或 5 列。您可以在流式 XSLT 3.0 转换中像这样缩减文件，其中 P、Q、R 和 S 是需要的列：
<xsl:transform version="3.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:mode streamable="yes" on-no-match="deep-skip"/>
<xsl:template match="/*">
<xsl:copy>
<xsl:apply-templates select="*"/>
</xsl:copy>
</xsl:template>
<xsl:template match="P|Q|R|S">
<xsl:copy-of select="."/>
</xsl:template>
</xsl:transform>
因为你没有提供细节，我不能给你细节。
您可以先使用 xslt 文件和 Application.TransformXML 方法 (documentation), and then import the XML using the Application.ImportXML method (documentation) 将 XML 转换为只包含您想要的数据。
请注意，Access 数据库的最大大小为 2GB。导入大文件很快就会超过此限制。
感谢您提供（巨大的）样本文件。我处理 xml 文件已经超过 15 年了。我一直怀疑 Ms Access 在接近 GB 限制时的表现如何。
根据我的经验，现在确认只有一位获胜者：
Open FileURL For Input As #FileNum。与 InputLine = Input(1000, #FileNum) ' read some 1.000 characters 组合。基本上，只需将 XML 视为纯文本文件即可。
如果可以使用 Line Input 代替 Input，编码会更容易，但在您的示例中情况并非如此。您的示例文件使用 vbLf 标记文本中一行的结尾，Line Input 需要 vbCrLf 才能正常工作。
我最终得到了一个小应用程序，它首先扫描文件以查找不同的出现标签。之后，这些标签可以分配给几个任务：
- 将值分配给 table 中的字段
- 跳过值
- 亲子-table
在第二次完整读取中，所有值都分配给它们在数据库中的目标字段。
我将尝试通过插入一些代码来澄清一下 (as of 02 Feb 2018 15h London time, I have to dash, I am gonna come back to it at a later point of time)
Option Compare Database
Option Explicit
Dim marrKnownTags() As String
Public Sub ReadFile2GB()
Dim FileNum As Integer
Dim InputLine As String
Call init_marrKnownTags
FileNum = FreeFile
Open "X:180128-gleif-concatenated-file-lei2.xml" For Input As #FileNum
Do While Not EOF(FileNum)
InputLine = Input(99000, #FileNum) ' read some 99.000 characters
Call processTemporaryBlock(InputLine)
...
Loop
Close #FileNum
End Sub
Public Function positionCrOfLf(PieceToScan As String) As Long
Dim Pos As Long
Pos = 0
If Pos = 0 Then
Pos = InStr(PieceToScan, vbCrLf)
End If
If Pos = 0 Then
Pos = InStr(PieceToScan, vbLf)
End If
If Pos = 0 Then
Pos = InStr(PieceToScan, vbCr)
End If
'Debug.Print "fie positionCrOfLf := " & Pos
positionCrOfLf = Pos
End Function
Private Sub init_marrKnownTags()
ReDim Preserve marrKnownTags(333)
marrKnownTags(1) = "<?xml version=" ' start of xml
marrKnownTags(10) = "<lei:LEIData" ' Table_01 Open
marrKnownTags(20) = "<lei:LEIHeader>" ' Table_02 Open
marrKnownTags(21) = "<lei:ContentDate>" ' field
marrKnownTags(22) = "<lei:FileContent>" ' field
marrKnownTags(23) = "<lei:RecordCount>" ' field
marrKnownTags(30) = "<lei:Extension>" ' Table_03 Open
marrKnownTags(40) = "<gleif:Sources>" ' Table_04 Open
marrKnownTags(41) = "<gleif:Source>" ' addnew record Table_04
marrKnownTags(42) = "<gleif:ContentDate>" ' field
marrKnownTags(43) = "<gleif:Originator>" ' field
marrKnownTags(44) = "<gleif:RecordCount>" ' field
marrKnownTags(45) = "</gleif:Source>" ' save this new record Table_04
marrKnownTags(46) = "</gleif:Sources>" ' Table_04 Close
marrKnownTags(31) = "</lei:Extension>" ' Table_03 Close
' ... some more child-tables in the future ??
marrKnownTags(129) = "</lei:Entity>" ' Table_12 Close ' close child table
marrKnownTags(140) = "<lei:Registration>" ' Table_14 Open
marrKnownTags(141) = "<lei:LastUpdateDate>" ' DO NOT SKIP field with "2017-11-30T15:06:27Z" =?= 2017-11-30 15:06:27
marrKnownTags(142) = "<lei:RegistrationStatus>" ' DO NOT SKIP field with "ISSUED"
marrKnownTags(149) = "</lei:Registration>" ' Table_14 Close
marrKnownTags(2) = "</lei:LEIRecord>" ' save this new record
marrKnownTags(2) = "</lei:LEIRecords>" ' Table_11 Close ' close child table
End Sub
Public Function processTemporaryBlock(ByVal TemporaryBlock As String)
Dim positionStart As Long, positionEnd As Long, positionLength As Long
Dim OneLine As String, searchTag As String
Dim indexArray As Long
Dim tagFoundYN As Boolean
positionStart = 1
positionEnd = positionCrOfLf(TemporaryBlock)
Do While positionEnd > 0
OneLine = trim(Mid(TemporaryBlock, positionStart, positionEnd - 1))
Debug.Print "OneLine := " & OneLine
tagFoundYN = False
For indexArray = LBound(marrKnownTags) To UBound(marrKnownTags)
searchTag = marrKnownTags(indexArray)
searchTag = Trim(searchTag)
If searchTag = "" Then
' skip
Else
If Left(OneLine, Len(searchTag)) = searchTag Then
' Call processTag(OneLine)
tagFoundYN = True
exit for
End If
End If
Next
positionStart = positionStart + positionEnd
positionEnd = positionCrOfLf(Mid(TemporaryBlock, positionStart))
Loop
End Sub