由于XML不完全是文本文件，而是具有编码和树结构的标记文件，因此请考虑使用MSXML，这是一个全面的符合W3C标准的XML API库，您可以使用它通过DOM方法（createElement、appendChild、setAttribute）而不是连接文本字符串来构建XML。
在VBA中，您可以通过早期绑定或后期绑定引用MSXML库，并且可以从Excel数据迭代构建树，如下所示。此外，MSXML还支持XSLT 1.0，这是一种用于转换XML文件的专用语言。下面运行Identity Transform，以使用换行符和缩进来漂亮地打印输出。否则，所有内容将呈现在一行上。
此外，让用户输入 * 完整 * 绝对范围路径以包括工作表名称（例如，Sheet1!A1:Z50）

XSLT*（保存为.xsl，一种特殊的.xml文件，可在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

• • 通过范围.值（xlRangeValueXML电子表格）选择**

我发现在xml中找到对表数据的 * 直接 * 访问非常有吸引力，因为它不涉及

• 范围和数组都不会循环，因为电子表格数据也可以XML格式使用
• 也不是纯字符串连接（参见@Parfait对OP的注解）

以创建期望形式的XML文件。

• • XSLT格式**

因此，您可以通过rng.Value(xlRangeValueMSPersistXML)或rng.Value(12)转换 * 电子表格数据（1）（可以 * 直接 * 使用）以及格式良好的xml内容**（2）。
XSLT转换（4）将根据单独的xsl内容字符串（3）中的逻辑执行。

• 请参阅@Parfait的精彩文章Reading a xml file ...中关于这种特殊用途的声明性XSLT语言的更多提示。*

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

范围方法有效，始终标识范围所在的工作表

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