Parsing xml/html like text file with VBA macro

Question

I have some raw data output in a text file from a program that I need to store and then format. The file output looks as such:

<Request>
    <code_set>1604</code_set>
    <start_code_value>-1</start_code_value>
    <block_size>10000</block_size>
    <ignore_access_ind>0</ignore_access_ind>
</Request>

All of the data is stored in Request or Reply block

All data is on a single row of the text file

Each request/reply block has many sub blocks - this is conditional; there could be 1, there could be 1,000

The data within the block is also conditional - there may be data and there may not be

I need to parse this out so in column A of an excel sheet it reads the name of the sub-block and column B has the data (if any).

omegastripes · Accepted Answer · 2015-02-11 19:38:47Z

Option Explicit

Sub ExtractParams()
    Dim sRawData, arrCells(), arrBlocks, arrBlock, arrSubBlocks, j, n, k
    ' Read raw data from the specified file
    sRawData = ReadTextFile("C:\Users\DELL\Desktop\tmp\tmp.txt", -2)
    j = 0
    ' Put each Request / Reply block name-content pairs into array
    ParseText sRawData, "<(Request|Reply)>([\s\S]*?)<\/\1>", arrBlocks
    For Each arrBlock In arrBlocks
        ' Put each subblock name-content pairs into array
        ParseText arrBlock(1), "<(\w*?)[\s\S]*?>([\s\S]*?)<\/\1>", arrSubBlocks
        n = UBound(arrSubBlocks)
        ' Converting array of arrays to 2-dimensional array
        Erase arrCells
        ReDim Preserve arrCells(n, 1)
        For k = 0 To n
            arrCells(k, 0) = arrSubBlocks(k)(0)
            arrCells(k, 1) = arrSubBlocks(k)(1)
        Next
        ' Output 2-dimensional array starting from next unfilled row
        ActiveSheet.Range(Cells(j + 1, 1), Cells(j + n + 1, 2)).Value = arrCells
        ActiveSheet.Columns.AutoFit
        j = j + n + 1
    Next
End Sub

Sub ParseText(sText, sPattern, arrItems)
    Dim oMatch, sSubMatch, arrItem
    arrItems = Array()
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = sPattern
        ' Process matches
        For Each oMatch In .Execute(sText)
            arrItem = Array()
            ' Process submatches
            For Each sSubMatch In oMatch.SubMatches
                ' Each submatch string add to array of submatches
                PushItem arrItem, sSubMatch
            Next
            ' Array of submatches for each match add to output array
            PushItem arrItems, arrItem
        Next
    End With
End Sub

Sub PushItem(arrList, varItem)
    ReDim Preserve arrList(UBound(arrList) + 1)
    arrList(UBound(arrList)) = varItem
End Sub

Function ReadTextFile(sPath, iFormat)
    ' iFormat defines the file format
    ' -2 - system default
    ' -1 - Unicode
    ' 0 - ASCII
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, iFormat)
        ReadTextFile = ""
        If Not .AtEndOfStream Then ReadTextFile = .ReadAll
        .Close
    End With
End Function

Collectives™ on Stack Overflow

Parsing xml/html like text file with VBA macro

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related