太阳帆数据 Sunfine Data

An example of processing XML file – treat it as text

By Zhanshan Dong on August 17th, 2009

The following example describes a way to process XML file, treating the XML file as text file. We all know that XML file is well structured and can be read and written by using specilized functions and classes. Sometime it is more convenient to treat the file as text file. Here is an simple example.

We have a series of data rows stored in a spreadsheet. The XML file includes a template that tell us how we can use the stored data to generate new items. Stored data only covers part of attributes described in the template. We’d like replace attrabutes in template with the available and leave the others as they are. It is easy to write a VBA subroutine to fullfil this purpose without using any XML processing functions.

The first row in the spread sheet includes name of each attribute. From the second row on, each row represent a data set for generating new items. Some cells in the row might be empty. The provided VBA code includes the mechanism to deal with the empty cells.
The VBA code includes three subroutines. The first one is main processing. The remaining two deal with reading and writing XML files. So the logic is very simple.

VBA Code
========
Option Explicit

Private temstr As String
Private lines

Sub insert_data()

    readxmltext

    lines = Split(temstr, Chr(13))

    Dim attr_name(14)
    Dim attr_pos(14)
    Dim attr_str(14)

    ' get attribute name
    Dim r, c, i, j, k
    r = 1
    For c = 2 To 15
        attr_name(c - 2) = ActiveSheet.Cells(r, c).Value
        attr_pos(c - 2) = -1
    Next c

    ' find attribute positions in temstr
    For i = 0 To UBound(lines)
        For j = 0 To 13
            Dim pos
            pos = InStr(lines(i), attr_name(j))
            If pos > 0 Then
                If (attr_pos(j) < 0) Then attr_pos(j) = i
                Exit For
            End If
        Next j
    Next i

    ' generate new items
    For r = 2 To 23
        For c = 2 To 15
               Dim attr_value
               attr_value = ActiveSheet.Cells(r, c).Value
               attr_str(c - 2) = "<" & attr_name(c - 2) & _
                  ">" & attr_value & ">"
               If (attr_value <> "") Then
                  lines(attr_pos(c - 2)) = attr_str(c - 2)
               End if
        Next c
        writexmltext
    Next r
End Sub

Sub readxmltext()
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("template.xml", ForReading)
    temstr = f.ReadAll()
    f.Close
End Sub

Sub writexmltext()
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("new.xml", 8, True)
    Dim i
    For i = 0 To UBound(lines)
        f.Write lines(i)
    Next i
    f.Close
End Sub