如何使用VBA保留XML文件中的仅所需文本

时间:2019-07-12 08:55:37

标签: vba

我在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>$
...

在这种情况下,我只需要:

H1
NormalColorChange
#00FFFFFF
Foreground
Foreground
Visibility
System
{x:Static Visibility.Hidden}

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

这是我提取的SUB:

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

1 个答案:

答案 0 :(得分:1)

这可以帮助您解析行:

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

还有1条评论:Dim GrapicFiles(), GrapicText() As String将GrapicFiles()声明为Variant。如果需要,请写Dim GrapicFiles() As String, GrapicText() As String