Home

转载：How to create XML file from scratch? - Simple Excel VBA

This is the third and the last part from the XML trilogy. Be sure You didn’t miss how to convert XML into Excel and how to overwrite XML file without copying or converting. In this article I’m going to show You how to create XML file from scratch.

# The case

Once again, take a look at the prepared XML file structure.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
<CATALOG>
	<PRODUCT name="A">
		<FEATURE1>A1</FEATURE1>
		<FEATURE2>A2</FEATURE2>
		<FEATURE3>A3</FEATURE3>
	</PRODUCT>
	<PRODUCT name="B">
		<FEATURE1>B1</FEATURE1>
		<FEATURE2>B2</FEATURE2>
		<FEATURE3>B3</FEATURE3>
	</PRODUCT>
	<PRODUCT name="C">
		<FEATURE1>C1</FEATURE1>
		<FEATURE2>C2</FEATURE2>
		<FEATURE3>C3</FEATURE3>
	</PRODUCT>
</CATALOG>

This is our goal. We want to achieve this starting from the Excel table showed below.

Product FEATURE1 FEATURE2 FEATURE3
A A1 A2 A3
B B1 B2 B3
C C1 C2 C3

# First theory

So let’s call the whole worksheet as catalog filled with products. Products are stored only in the first column, features are in the rest of the columns.

So, the child nodes of the catalog (worksheet) are products (1st column). Features are child nodes of the products. Summing up – 3 levels. The first one is known, there is only 1 catalog, which opens in the beginning and closes in the end. Second is products and the third one is features.

We can see how many products and features are in the table, but let’s write the code universal, in case of change.

# Practice!

To start coding in the first place You need your future XML file path.

1
xml_file = "...\test2.xml"

Then create the file and mark it as output with number.

1
Open xml_file For Output As #1

Now every time You want to write a new line in the xml_file just put Print method and type the number You chose above with hashtag.

Let’s start manually with typing CATALOG.

1
Print #1, "<CATALOG>"

Now the hardest part. You need 2 loops – for columns and rows. While looping in columns remember, that first column is the name of the product – start with Product tag, in the second the features begin and after the last feature (last column) You need to end with Product tag. Just like in the XML structure I showed You up there.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
For i = 2 To lastRow
    For j = 1 To lastCol
        head = UCase(.Cells(1, j))
        val = .Cells(i, j)
        If j = 1 Then
            prod = head
            Print #1, "<" & prod & " name=""" & val & """>"
        Else
            Print #1, "<" & head & ">" & val & "</" & head & ">"
            If j = lastCol Then
                Print #1, "</" & prod & ">"
            End If
        End If
    Next
Next

In the last part, after all loops, You need to close the CATALOG and close the output xml_file.

1
2
Print #1, "</CATALOG>"
Close #1

# Code

Full code below.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Option Explicit

Sub xml_creation()

Dim xml_file As String, head As String, val As String
Dim prod As String
Dim lastRow As Long, lastCol As Long, i As Long, j As Long
Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets(1)
xml_file = "...\test2.xml"

Open xml_file For Output As #1
Print #1, "<CATALOG>"

With ws
    lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column

    For i = 2 To lastRow
        For j = 1 To lastCol
            head = UCase(.Cells(1, j))
            val = .Cells(i, j)
            If j = 1 Then
                prod = head
                Print #1, "<" & prod & " name=""" & val & """>"
            Else
                Print #1, "<" & head & ">" & val _
                    & "</" & head & ">"
                If j = lastCol Then
                    Print #1, "</" & prod & ">"
                End If
            End If
        Next
    Next

End With

Print #1, "</CATALOG>"
Close #1

End Sub

# Some end words

And this is it! End of the last part from this XML trilogy! Now You should know how to create XML file from scratch along with converting XML into Excel and overwriting XML. I hope You enjoyed that and those articles will be helpful at least a little bit.

# Comments

Create XML base header and records.

Sheet1 header

VERSION COUNT DATE
A01 3 2023-08-11

Sheet2 records

serial_number mac_address hardware_ver
SN01 1
SN02 1
SN03 1

Goal XML

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
<?xml version="1.0" encoding="ASCII" standalone="yes"?>
<file>
  <header>
    <version>A01</version>
    <count>5</count>
    <date>2023-08-11</date>
  </header>
  <records>
    <record>
      <serial_number>SN01</serial_number>
      <mac_address/>
      <hardware_ver>1</hardware_ver>
    </record>
    <record>
      <serial_number>SN02</serial_number>
      <mac_address/>
      <hardware_ver>1</hardware_ver>
    </record>
    <record>
      <serial_number>SN03</serial_number>
      <mac_address/>
      <hardware_ver>1</hardware_ver>
    </record>
  </records>
</file>

VBA code

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Option Explicit

Sub CreateXML()
    Dim xml_filepath As String, tag As String, val As String, indent_space As Long, need_trim As Boolean
    Dim last_row As Long, last_col As Long, i As Long, j As Long
    Dim ws_header As Worksheet, ws_records As Worksheet
    Dim start_time As Single
    
    start_time = Timer

    indent_space_space = 2 ' If use tab (Chr(9)) can reduce file size.
    need_trim = True
    Set ws_header = ThisWorkbook.Sheets(1)
    Set ws_records = ThisWorkbook.Sheets(2)
    
    xml_filepath = Left(ThisWorkbook.FullName, InStr(ThisWorkbook.FullName, ".") - 1) & ".xml"
    
    Open xml_filepath For Output As #1
    Print #1, "<?xml version=""1.0"" encoding=""ASCII"" standalone=""yes""?>"
    Print #1, "<file>"
    
    Print #1, Space(indent_space) & "<header>"
    For j = 1 To ws_header.Cells(1, Columns.Count).End(xlToLeft).Column
        tag = LCase(ws_header.Cells(1, j))
        If need_trim Then
            val = Trim(ws_header.Cells(2, j))
        Else
            val = ws_header.Cells(2, j)
        End If
        
        If val = "" Then
            Print #1, Space(indent_space * 3) & "<" & tag & "/>"
        Else
            Print #1, Space(indent_space * 2) & "<" & tag & ">" & val & "</" & tag & ">"
        End If  
    Next
    Print #1, Space(indent_space) & "</header>"
    

    Print #1, Space(indent_space) & "<records>"
    With ws_records
        last_row = .Cells(Rows.Count, 1).End(xlUp).Row
        last_col = .Cells(1, Columns.Count).End(xlToLeft).Column
        
        For i = 2 To last_row
            Print #1, Space(indent_space * 2) & "<record>"
            For j = 1 To last_col
                tag = LCase(.Cells(1, j))
                If need_trim Then
                    val = Trim(.Cells(i, j))
                Else
                    val = .Cells(i, j)
                End If
                
                If val = "" Then
                  Print #1, Space(indent_space * 3) & "<" & tag & "/>"
                Else
                  Print #1, Space(indent_space * 3) & "<" & tag & ">" & val & "</" & tag & ">"
                End If     
            Next
            Print #1, Space(indent_space * 2) & "</record>"
        Next
    End With
    Print #1, Space(indent_space) & "</records>"
    Print #1, "</file>"

    Close #1
    
    Debug.Print "Transfer Success! Cost Time " & Timer - start_time & "s"
'    MsgBox "Transfer Success! Cost Time " & Timer - start_time & "s"
End Sub
Edited on