How to automatically get a specified range of data from Excel to XML in VBA

Question

I need to automate the process in which the range of data is selected.

Right now the user gets prompted to input the data range through an input box and it creates an XML file with that data, but I need it so that the script gets the data range from the Excel sheet where it is specified in a cell Excel sheet example

In the end the XML file should look like this:

<?xml version="1.0"  encoding="ISO-8859-1"?>
<DeclarationFile>
<R13>
<K7>5555.555 </K7>
<K8>333.333 </K8>
<K9>22.22 </K9>
</R13>
<R14>
<K7>1.111 </K7>
<K8>2.222 </K8>
<K9>4.4444444 </K9>
</R14>
<R17>
<K7>444.44 </K7>
<K8>333.333 </K8>
<K9>9.999 </K9>
</R17>
</DeclarationFile>

Current script code:

Sub CreateXMLFile()
    Const THE_FOLDER As String = "C:\"
    Dim ws As Worksheet, rngData As Range, fName As String, rw As Long, col As Long
    Dim xml As String, tagId As String, tagVal As String, v
    
    
    fName = "C:\EDS\xml1.xml"
    
    
    On Error Resume Next
    Set rngData = Application.InputBox("2. Enter the range of data (Including Headers):", _
                                       "CreateXMLFile", Type:=8)
    On Error Resume Next
    
    If rngData Is Nothing Then
        Debug.Print "Range not specified"
        Exit Sub
    End If
    
    Open fName For Output As #1
    Print #1, "<?xml version=""1.0""  encoding=""ISO-8859-1""?>"
    Print #1, "<DeclarationFile>"
    
    For rw = 2 To rngData.Rows.Count
        tagId = rngData.Cells(rw, 1).Value
        Print #1, "<" & tagId & ">"
        For col = 2 To rngData.Columns.Count
            tagVal = rngData.Cells(1, col).Value
            v = rngData.Cells(rw, col).Value
            Print #1, "<" & tagVal & ">" & Replace(CheckForm(v), "&", "+") & "</" & tagVal & ">"
        Next col
        Print #1, "</" & tagId & ">"
    Next rw
    Print #1, "</DeclarationFile>"
    
    Open fName For Output As #1
    Close #1
    
    MsgBox fName & " created." & vbLf & "Done", vbOKOnly + vbInformation, "CreateXMLFile"
    Debug.Print fName & " saved."
End Sub

Function CheckForm(v) As String
    If IsNumeric(v) Then v = Format(v, "#.######## ;(0.########)")
    CheckForm = CStr(v)
End Function

I tried getting the range from the A1 cell into a string variable and then into rngData, but that only gave me an empty XML file:

<?xml version="1.0"  encoding="ISO-8859-1"?>
<DeclarationFile>
</DeclarationFile>

I also tried it with Range(), but I just kept getting errors.

Any help is appreciated!

[What's so bad about building XML with string concatenation?](https://stackoverflow.com/q/3034611/1422451) — Parfait, Feb 26 '23 at 02:52
@Parfait Took the liberty to insert line separator into Application.InputBox to avoid error message. - Fyi You might be interested in my late post trying to execute xslt directly upon xml data received via `rng.Value(xlRangeValueMSPersistXML)`. This post intends to show an interesting alternative leading to possible new ideas or optimization. Btw I fully support your criticism of string concatenation. @Parfait — T.M., Feb 28 '23 at 20:31

score 2 · Answer 1 · edited Feb 28 '23 at 20:19

Since XML is not quite a text file but a markup file with encoding and tree structure, consider using MSXML, a comprehensive W3C compliant library of XML APIs which you can use to build your XML with DOM methods (createElement, appendChild, setAttribute) instead of concatenating text strings.

In VBA, you can reference the MSXML library by early or late-binding, and can iteratively build a tree from Excel data as shown below. Even more, MSXML supports XSLT 1.0, the special-purpose language used to transform XML files. Below runs the Identity Transform to pretty print the output with line breaks and indentation. Otherwise, all content renders on a single line.

Also, have users enter the full absolute range path to include sheet name (e.g., Sheet1!A1:Z50)

XSLT (save as .xsl, a special .xml file, to be read in VBA)

<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
  <xsl:output method="xml" indent="yes" encoding="ISO-8859-1"/>
  <xsl:strip-space elements="*"/>

  <!-- IDENTITY TRANSFORM -->
  <xsl:template match="@*|node()">
    <xsl:copy>
      <xsl:apply-templates select="@*|node()"/>
    </xsl:copy>
  </xsl:template>

</xsl:stylesheet>

VBA

Sub xmlExport()
On Error GoTo ErrHandle
    ' VBA REFERENCE MSXML, v6.0
    Dim doc As MSXML2.DOMDocument60, xslDoc As MSXML2.DOMDocument60, newDoc As MSXML2.DOMDocument60
    Dim rootNode As IXMLDOMElement, tagNode As IXMLDOMElement, chTagNode As IXMLDOMElement
    
    Dim rnData As Range
    Dim fName  As String, chTagVal As String
    Dim rw As Long, col As Long
   
    fName = "C:\EDS\xml1.xml"

    Set rngData = Application.InputBox( _
        Prompt := "2. Enter the sheet range of data (Including Headers) (e.g., Sheet1!A1:Z50):", _
        Title := "CreateXMLFile", _
        Type := 8 _
    )

    ' INITIALIZE XML DOC
    Set doc = New MSXML2.DOMDocument60

    ' APPEND ROOT NODE
    Set rootNode = doc.createElement("DeclarationFile")
    doc.appendChild rootNode

    ' ITERATE THROUGH RANGE
    For rw = 2 To rngData.Rows.Count
        ' APPEND TAG TO ROOT
        Set tagNode = doc.createElement(rngData.Cells(rw, 1).Value)
        rootNode.appendChild tagNode

        For col = 2 To rngData.Columns.Count
            ' APPEND CHILD TAG
            Set chTagNode = doc.createElement(rngData.Cells(1, col).Value)
            tagNode.appendChild chTagNode

            ' ADD TEXT VALUE
            chTagVal = rngData.Cells(rw, col).Value
            chTagNode.Text = Replace(CheckForm(chTagVal), "&", "+")
        Next col
    Next rw


    ' INITIALIZE XSL DOC
    Set xslDoc = New MSXML2.DOMDocument60
    Set newDoc = New MSXML2.DOMDocument60

    ' LOAD XSLT AND TRANSFORM
    xslDoc.Load "C:\Path\To\Script.xsl"
    xslDoc.async = False
    doc.transformNodeToObject xslDoc, newDoc

    ' SAVE XML TO FILE
    newDoc.Save fName

    MsgBox fName & " created." & vbLf & "Done", vbOKOnly + vbInformation, "CreateXMLFile"
    Debug.Print fName & " saved."

ExitHandle:
    Set rngData = Nothing
    Set rootNode = Nothing: Set tagNode = Nothing: Set chTagNode = Nothing
    Set doc = Nothing: Set xslDoc = Nothing: Set newDoc = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Resume ExitHandle
End Sub

Function CheckForm(v) As String
    If IsNumeric(v) Then v = Format(v, "#.######## ;(0.########)")
    CheckForm = CStr(v)
End Function

score 1 · Answer 2 · answered Feb 28 '23 at 20:17

Alternative via Range.Value(xlRangeValueXMLSpreadsheet)

I found it appealing to find direct access to table data in xml that does not involve

neither range or array loops, since spreadsheet data is also available in XML form anyway
nor pure string concatenation (see @Parfait 's comment to OP)

to create an xml file in the desired form.

XSLT

So you might profit from *transforming spreadsheet data (1) which may be used directly as well formed xml content (2) via rng.Value(xlRangeValueMSPersistXML) or rng.Value(12).

The XSLT transformation (4) will be executed based on the logic in a separate xsl content string (3).

See further hints to this special-purpose, declarative XSLT language in @Parfait 's fine post Reading an xml file ....

Sub Value12()
Const fname As String = "Test12.xml"
Dim t As Double: t = Timer
'1) define data range
    Dim rng As Range
    Set rng = Sheet1.Range("A2:D5")         ' << change to wanted Sheet
'2) load basic xml data
    Dim xDoc   As New MSXML2.DOMDocument60
    xDoc.LoadXML xmlContent(rng)            ' << load xmlContent string
'3) load xml style sheet containing specific transfer syntax
    Dim xslDoc As New MSXML2.DOMDocument60
    xslDoc.LoadXML xslContent(rng)          ' << load xslContent string
'4) transfer to wanted data structure via xslt
    xDoc.transformNodeToObject xslDoc, xDoc
'5) save xml to file
    xDoc.Save ThisWorkbook.Path & "\" & fname

    MsgBox fname & " created " & vbLf & "in " & Format(Timer - t, "0.00 secs."), vbOKOnly + vbInformation, "Create XML File (T.M.)"
    Debug.Print xDoc.XML
End Sub

Function xmlContent(rng As Range) As String
'Purp.: change range values to specific xml structure via .Value(12)
    Dim content As String
    content = rng.Value(12)                 ' or: .Value(xlRangeValueMSPersistXML)
    content = Replace(content, ":", "")     ' brute force avoiding namespace references
    xmlContent = content
End Function

Function xslContent(rng As Range) As String
'Purp.: get wellformed xsl content string
'a) define basic content pattern
    Dim arr(0 To 15)
    arr(0) = "<xsl:stylesheet xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"" version=""1.0"">"
    arr(1) = "  <xsl:output method=""xml"" encoding=""utf-8"" indent=""yes""/>"
    arr(2) = "  <xsl:strip-space elements=""*""/>"
    arr(3) = ""                                  ' to be replaced with header variables
    arr(4) = "<xsl:template match=""/"">"
    arr(5) = "  <DeclarationFile>"
    arr(6) = "     <xsl:for-each select=""//rsdata/zrow"">"
    arr(7) = "        <xsl:element name=""{@Col1}"">"
    arr(8) = "           <xsl:element name=""{$H1}""><xsl:value-of select=""@Col2""/></xsl:element>"
    arr(9) = "           <xsl:element name=""{$H2}""><xsl:value-of select=""@Col3""/></xsl:element>"
    arr(10) = "           <xsl:element name=""{$H3}""><xsl:value-of select=""@Col4""/></xsl:element>"
    arr(11) = "        </xsl:element>"
    arr(12) = "    </xsl:for-each>"
    arr(13) = "  </DeclarationFile>"
    arr(14) = "</xsl:template>"
    arr(15) = "</xsl:stylesheet>"
'b) define header variables
    Dim hdr: hdr = Application.Transpose(Application.Transpose(rng.Rows(1).Value2))
    Dim i As Long
    For i = 1 To UBound(hdr) - 1
        hdr(i) = "<xsl:variable name = ""H" & i & """>" & Trim(hdr(i + 1)) & "</xsl:variable>"
    Next
    ReDim Preserve hdr(1 To UBound(hdr) - 1)
'c) insert header variables
    arr(3) = Join(hdr, vbNullString)
'd) return xsl content
    xslContent = Join(arr, vbNewLine)
End Function

Hint: This post doesn't pretend to offer a "best" approach, but intends to show an alternative way to profit from spreadsheet data being available as *xml* content string. My approach may be optimized in any way (so namespace references might be included easily; xsl might be loaded also as file, etc). — T.M., Feb 28 '23 at 20:43

score 0 · Accepted Answer · answered Feb 25 '23 at 23:29

0

Range method works, always identify the sheet where the range is located

    Set rngData = Sheets("Sheet1").Range(Sheets("Sheet1").Range("A1"))

answered Feb 25 '23 at 23:29

wrbp

870
1
3
9

This works, thanks! I'm new to VBA so I didn't know about the sheet. – N_B Feb 25 '23 at 23:40

How to automatically get a specified range of data from Excel to XML in VBA

3 Answers3