如何使用vba从XML文件中保留只需要的文本

我在excel中使用VBA，它可以查找编码为XML文件的文件中是否存在特定值。XML文件很大，超过100000行，包含几百万个字符，为了提高速度，我正在将XML文件加载到一个数组中。当我使用100个XML文件时，一切对我都有效，但是，如果有>200个XML文件，excel将消耗太多RAM，代码将失败并出现“运行时错误7内存不足”

我认为我只需要XML代码中的特定值，它总是以：=开始，以：。结束，所以如果我删除所有其他内容，只保留所需的文本，这将节省大量消耗的RAM

例如，我的XML文件包含：

...
$<yiapcspvgdldm:Condition.ActionTypes>
<yiapcspvgdldm:ColorChange
    BrushStyle="H1"
    ColorChangeType="NormalColorChange"
    Color="#00FFFFFF"
    PropertyName="Foreground" />
<yiapcspvgdldm:Blinking
    PropertyName="Foreground" />
<yiapcspvgdldm:Set
    AttributeName="Visibility"
    AttributeType="System"
    To="{x:Static Visibility.Hidden}" />
</yiapcspvgdldm:Condition.ActionTypes>$
...

正如我所提到的，每个文件包含>100000行，我试图遍历字符串的每一行直到EOF，但这需要很长时间。。。 我尝试了分割函数，但这只是分割文本，并没有删除不需要的文本。 我试图在这里找到我的答案，但没有成功。任何帮助都将不胜感激

以下是我的摘录：

Dim GrapicFiles(), GrapicText() As String
Dim PrjtFolder as string

Sub LoadXML()
Dim i, GraphCount As Integer
Dim Path, FileName As String
Dim objFSO, objTF As Object
Dim strIn As Variant

PrjtFolder="C:\temp\"

If Worksheets("Work").FilterMode Then Worksheets("Work").ShowAllData
GraphCount = Application.WorksheetFunction.CountA(Worksheets("Work").Range("B:B")) - 1


For i = 1 To GraphCount
    DoEvents

    FileName = Worksheets("Work").Cells(i + 1, 2).Value
    Path = PrjtFolder & FileName & "\Main.xml"

        'Load files to array

        ReDim Preserve GrapicFiles(UBound(GrapicFiles) + 1)
        ReDim Preserve GrapicText(UBound(GrapicText) + 1)

            'Text Reading
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objTF = objFSO.OpenTextFile(Path, 1)
            strIn = objTF.readall
            objTF.Close
            Set objFSO = Nothing
            Set objTF = Nothing

    '>>>>>>>I will need something here to make my 'strIn' string smaller

        'saving to array
        GrapicFiles(i) = FileName
        GrapicText(i) = strIn
        Set strIn = Nothing

Next i

End Sub

---

这可能有助于您分析以下行：

Dim GrapicText() As String
Dim sLine As String
Dim i As Long, iPos As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile("C:\Users\acs.erno\Documents\Prog\Frm\x.xml", 1)
strIn = objTF.readall
objTF.Close
Set objFSO = Nothing
Set objTF = Nothing

GrapicText = Split(strIn, vbCrLf)    ' split to buffer
For i = LBound(GrapicText) To UBound(GrapicText)
    iPos = InStr(GrapicText(i), "=") 
    If iPos > 0 Then                 ' lines with "=" only
        sLine = Mid$(GrapicText(i), iPos + 2)
        iPos = InStrRev(sLine, """")    ' find terminal "
        If iPos > 1 Then sLine = Left$(sLine, iPos - 1)
        Debug.Print sLine
    End If
Next

---

还有一句话：Dim GraphicFiles，GraphicText作为字符串声明GraphicFiles作为变量。将Dim GraphicFiles写入字符串，将GraphicText写入字符串（如果需要），字符串

Redim Preserve是一个相当耗费资源的操作。它分配新大小的内存，复制原始数组，然后释放原始数组占用的内存。所以它需要两倍的内存。为什么不在循环之前重拨一次？你知道档案的数量。语义方面：如果您在文件中搜索特定的值，可以使用InStr函数来决定。@AcsErno谢谢您的建议，我已经测试过了，但是它并没有对代码做太多改进。我必须先加载所有文件，然后再使用InStr进行检查。我以前考虑过这个解决方案，但不是我需要的。还有别的想法吗？有没有一种方法可以循环我的strIn变量并检查每一行的=？逐行循环字符串将比逐行读取文件快。我尝试使用SPLIT函数，然后使用a FOR EACH，但是使用SPLIT的数组的大小变得太大，所以它会在SPLIT函数中永远循环…这里有一个很好的解决方案，Argut solution 3使用GET，但没有指定获取字符串后如何操作它…感谢这个解决方案。这确实是我被要求的，但我认为处理每一行的想法仍然不好。。。我应该考虑使用不同的比较源，而不是使用XML文件。感谢您对变量“variant”类型的建议，做了一些改进…@Andy您可能会找到一些可下载的XML解析器，但它们在内部执行相同的操作：在char-by-char行中搜索=sign，然后用=sign分隔键和值。您可以通过debug.print time在sub的开头和结尾分析块所需的时间，并首先注释掉行处理部分，使文件保持打开和readall，然后注释掉readall。我的猜测是，行处理部分需要的时间比文件打开要少得多。

Dim GrapicText() As String
Dim sLine As String
Dim i As Long, iPos As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile("C:\Users\acs.erno\Documents\Prog\Frm\x.xml", 1)
strIn = objTF.readall
objTF.Close
Set objFSO = Nothing
Set objTF = Nothing

GrapicText = Split(strIn, vbCrLf)    ' split to buffer
For i = LBound(GrapicText) To UBound(GrapicText)
    iPos = InStr(GrapicText(i), "=") 
    If iPos > 0 Then                 ' lines with "=" only
        sLine = Mid$(GrapicText(i), iPos + 2)
        iPos = InStrRev(sLine, """")    ' find terminal "
        If iPos > 1 Then sLine = Left$(sLine, iPos - 1)
        Debug.Print sLine
    End If
Next