Question

我需要使用xml文件中的一些数据，其大小约为＆gt; 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文件？

Answer 1

我不知道在VBA / Access下可能有什么用处，但是为这个大小的输入构建一个DOM可能是不可行的。

MSXML解析器（您正在使用）也有一个SAX api，解析器读取输入文件并通知应用程序诸如开始标记，结束标记，属性和文本节点之类的事件。这可能会满足您的需求，但编程可能会很棘手。

Microsoft的.NET解析器（System.Xml）也有一个“拉”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>

Answer 2

由于您未提供具体信息，我无法向您提供具体信息。

您可以先使用xslt文件和Application.TransformXML方法（documentation）将XML转换为仅包含所需数据，然后使用Application.ImportXML方法导入XML（ documentation）。

请注意，Access数据库的最大大小为2GB。导入大文件很快就会超出此限制。

Answer 3

感谢（巨大的）样本文件。我已经处理xml文件超过15年了。我总是怀疑在接近GB限制时Access如何执行。

根据我的经验，现在确认，只有一个赢家： Open FileURL For Input As #FileNum。与InputLine = Input(1000, #FileNum) ' read some 1.000 characters结合使用。基本上，只需将XML视为纯文本文件。

如果可以使用Line Input代替Input，则编码会更容易，但在您的示例中，情况并非如此。您的示例文件使用vbLf标记文本中一行的结尾，Line Input需要vbCrLf才能正常工作。

我最终得到了一个小应用程序，它首先扫描文件以查找不同的实际标签。之后，可以将这些标记分配给以下几个任务：

将值分配给表中的字段
只是跳过值
close child-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:\20180128-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文件

3 个答案: