An example of processing XML file - treat it as text
Zhanshan Dong
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 & "</" & attr_name(c - 2) & ">>"
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
©董占山Zhanshan Dong
|
