Generate XML File with VBA - excel

Question

I'm trying to generate an XML file with VBA code.
My goal is to alter Excel data, and then to export this data into a valid XML file. There's only one row of data and one row for the name of the tags which I want to have the data inside.
How can I run through all the data and generate an XML file?
Some sample data (My original file has more columns and data).
(The yellow data is my first block in XML and the green data my second block.)
Here's how the XML File should look:
<?xml version="1.0" encoding="UTF-8"?>
<NmLoader>
<csvBeginTypeDefView handler ="TypeDefinition">
<csvattTemplate>LW</csvattTemplate>
<csvnameSpace>default</csvnameSpace>
<csvname>Tires</csvname>
<csvcontainerDomain/>
<csvtypeParent>Wheels</csvtypeParent>
</csvBeginTypeDefView>
<csvBeginAttributeDefView handler = "AttributeDefinition">
<csvname>TiresAT</csvname>
<csvattDefClass>Definition</csvattDefClass>
<csvdatatype>String</csvdatatype>
<csvIBA>TiresAT</csvIBA>
<csvQoM/>
</csvBeginAttributeDefView>
</NmLoader>
My Code:
Public Sub GenerateXML()
Dim sht As Worksheet
Dim loLetzteZ As Long, loLetzteS As Long, i As Long
Dim rBereich As Range, rng As Range
Dim sTagO As String, sTagC As String, sTagOEnd As String, sTagCStart As String
Dim sZeile As String
Dim strPfad As String
Dim strText As String
sTagO = "<"
sTagOEnd = "/>"
sTagC = ">"
sTagCStart = "</"
Set sht = Worksheets("Data")
'determine the last possible row
loLetzteZ = sht.Cells(Rows.Count, 1).End(xlUp).Row
'determine the last possible column
loLetzteS = sht.Cells(1, Columns.Count).End(xlToLeft).Column
'set me the area for the complete worksheet
Set rBereich = sht.Range("A2:" & Cells(loLetzteZ, loLetzteS).Address)
Application.ScreenUpdating = False
strPfad = ActiveWorkbook.Path & "\Data" & ".xml"
'row for row
For Each rng In rBereich.Rows
With rng
'column for column
For i = 1 To .Columns.Count
'If the tag is empty, then close this
If IsEmpty(.Cells(1, i)) Then
sZeile = sZeile & sTagO & Cells(1, i) & sTagOEnd
Else
'Opening Tag
sZeile = sZeile & sTagO & Cells(1, i) & sTagC
'Data for the tags
sZeile = sZeile & .Cells(1, i)
'End of Tags
sZeile = sZeile & sTagCStart & Cells(1, i) & sTagC
End If
'Write line with distance
sZeile = sZeile & vbCrLf
Next
'Write line with distance
sZeile = sZeile & vbCrLf & vbCrLf
'Open file and write the text
Call InDateiSchreiben(strPfad, sZeile, True)
End With
Next
Application.ScreenUpdating = True
End Sub
Other Solutions I tried:
I've already mapped the XML with Excel, but Excel is not able to export such an XML Schema.
I wrote code in VBA (I'm a beginner) by looking through posts regarding an XML Export.

Answer 1

Try this
Function GetXmlElement(sTagName As String, _
sValue As String, _
Optional bUseEmptyTags As Boolean = False, _
Optional bMultiline As Boolean = False) As String
Dim sStartOpen As String: sStartOpen = "<"
Dim sClose As String: sClose = ">"
Dim sEndOpen As String: sEndOpen = "</"
Dim sEmptyClose As String: sEmptyClose = " />"
Dim sTab As String: sTab = " "
Dim sTagValSeparator As String
Dim sValTagSeparator As String
If bMultiline Then
sTagValSeparator = Chr(10) & sTab
sValTagSeparator = Chr(10)
End If
If Len(sValue) = 0 And bUseEmptyTags Then
GetXmlElement = sStartOpen & sTagName & sEmptyClose
Else
GetXmlElement = sStartOpen & sTagName & sClose & sTagValSeparator & _
Replace(sValue, Chr(10), Chr(10) & sTab) & _
sValTagSeparator
If InStr(1, sTagName, " ") > 0 Then
'tag has attributes'
sTagName = Left(sTagName, InStr(1, sTagName, " ") - 1)
End If
GetXmlElement = GetXmlElement & sEndOpen & sTagName & sClose
End If
End Function
Function GetXMLOutput() As String
Dim lLastCol As Long
Dim i As Long
Dim lCsvBeginCol As Long
Dim sTagName As String
Dim sInnerElements As String
Dim sOutput As String
With ThisWorkbook.Sheets("Data")
lLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
lCsvBeginCol = 1
For i = 1 To lLastCol
sTagName = .Cells(1, i)
If Left(sTagName, 8) = "csvBegin" And i > lCsvBeginCol Or i = lLastCol Then
' build the outer element
sTagName = .Cells(1, lCsvBeginCol) & "=""" & .Cells(2, lCsvBeginCol) & """"
If Len(sOutput) > 0 Then
sOutput = sOutput & Chr(10) & Chr(10)
End If
sOutput = sOutput & GetXmlElement(sTagName, sInnerElements, True, True)
lCsvBeginCol = i
sInnerElements = ""
ElseIf i <> lCsvBeginCol Then
' build the inner elements
If Len(sInnerElements) > 0 Then sInnerElements = sInnerElements & Chr(10)
sInnerElements = sInnerElements & GetXmlElement(sTagName, .Cells(2, i), True)
End If
Next i
sOutput = GetXmlElement("NmLoader", sOutput, True, True)
sOutput = "<?xml version=""1.0"" encoding=""UTF-8""?>" & Chr(10) & Chr(10) & sOutput
GetXMLOutput = sOutput
Debug.Print sOutput
End With
End Function
Sub GenerateXML()
Dim sFilename As String
sFilename = ThisWorkbook.Path & "\Data.xml"
Open sFilename For Output As #1
Print #1, GetXMLOutput
Close #1
End Sub

Answer 2

Try
Option Explicit
Public Sub GenerateXML()
Dim sht As Worksheet
Set sht = Worksheets("Data")
Dim loLetzteZ As Long, loLetzteS As Long, i As Long
Dim rBereich As Range, rng As Range
Dim sZeile As String
Dim strPfad As String
Dim sTag As String, sTag1 As String, sData As String
'determine the last possible row
loLetzteZ = sht.Cells(Rows.Count, 1).End(xlUp).Row
'determine the last possible column
loLetzteS = sht.Cells(1, Columns.Count).End(xlToLeft).Column
'set me the area for the complete worksheet
Set rBereich = sht.Range("A2:" & Cells(loLetzteZ, loLetzteS).Address)
' output
strPfad = ActiveWorkbook.Path & "\Data" & ".xml"
sTag1 = ""
sZeile = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf _
& "<NmLoader>" & vbCrLf
'row for row
For Each rng In rBereich.Rows
With rng
'column for column
For i = 1 To .Columns.Count
sTag = Trim(sht.Cells(1, i))
sData = Trim(.Cells(1, i))
'If the tag is handler
If LCase(Right(sTag, 7)) = "handler" Then
sTag1 = Split(sTag, " ")(0) ' remove handler
sZeile = sZeile & "<" & sTag1 & " handler=""" & sData & """>"
' is it a closing tag
ElseIf sTag = sTag1 Then
sZeile = sZeile & "</" & sTag1 & ">" & vbCrLf
ElseIf Len(sData) > 0 Then
sZeile = sZeile & vbTab & "<" & sTag & ">" & sData & "</" & sTag & ">"
Else
sZeile = sZeile & vbTab & "<" & sTag & "/>"
End If
sZeile = sZeile & vbCrLf
Next
'Write line with distance
sZeile = sZeile & vbCrLf & "</NmLoader>" & vbCrLf
'Open file and write the text
Debug.Print sZeile
'Call InDateiSchreiben(strPfad, sZeile, True)
End With
Next
MsgBox strPfad & " created", vbInformation
End Sub