Question

使用Excel中的宏VBA，我需要在excel文件中转换1张纸上的日期。为此，我已经创建了一个脚本，但是我有一个问题是在XML中正确生成日期我需要第一行标题，然后公式读取所有包含数据的行。

 Sub createXML()

Sheets("Sheet1").Select

    FullPath = baseDirectory & projectName & "\xmlBatch\inputTest.xml"

    Set objStream = CreateObject("ADODB.Stream")
    objStream.Charset = "iso-8859-1"

    objStream.Open
    objStream.WriteText ("<?xml version='1.0' encoding='UTF-8'?>" & vbLf)
    objStream.WriteText ("<y:input xmlns:y='http://www.test.com/engine/3'>" & vbLf)
    objStream.WriteText ("  <y:datas>" & vbLf)
    objStream.WriteText ("      <y:instance yid='theGeneralData'>" & vbLf)
    objStream.WriteText ("" & vbLf)

    objStream.WriteText ("<language yid='LANG_en' />" & vbLf)

    objStream.WriteText ("<client yclass='Client'>" & vbLf)
    objStream.WriteText ("  <firstName>" & Cells(1, 1).Text & "</firstName>" & vbLf)
    objStream.WriteText ("  <lastName>" & Cells(1, 2).Text & "</lastName>" & vbLf)
    objStream.WriteText ("  <age>" & Cells(1, 3).Text & "</age>" & vbLf)
    objStream.WriteText ("  <civility yid='" & toYID(Cells(1, 4).Text) & "' />" & vbLf)
    objStream.WriteText ("</client>" & vbLf)

    objStream.WriteText ("" & vbLf)
    objStream.WriteText ("      </y:instance>" & vbLf)
    objStream.WriteText ("  </y:datas>" & vbLf)
    objStream.WriteText ("</y:input>" & vbLf)               
    objStream.SaveToFile FullPath, 2
    objStream.Close   
End Sub

excel数据现在采用以下格式：

enter image description here

但我现在的输出是：

> <?xml version='1.0' encoding='UTF-8'?>
<y:input xmlns:y='http://www.test.com/engine/3'>
  <y:datas>
      <y:instance yid='theGeneralData'>

<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>firstName</firstName>
  <lastName>lastName</lastName>
  <age>age</age>
  <civility yid='CIVILITY' />
</client>   
      </y:instance>
  </y:datas>
</y:input>

我们需要输出：

> <?xml version='1.0' encoding='UTF-8'?>
<y:input xmlns:y='http://www.test.com/engine/3'>
  <y:datas>
      <y:instance yid='theGeneralData'>

<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>1</firstName>
  <lastName>1</lastName>
  <age>1</age>
  <civility yid='CIVILITY' />
</client>
<client yclass='Client'>
  <firstName>2</firstName>
  <lastName>2</lastName>
  <age>2</age>
  <civility yid='CIVILITY' />
</client>
<client yclass='Client'>
  <firstName>3</firstName>
  <lastName>3</lastName>
  <age>3</age>
  <civility yid='CIVILITY' />
</client>
      </y:instance>
  </y:datas>
</y:input>

Answer 1

考虑使用MSXML，这是一个全面的符合W3C标准的XML API库，您可以使用它来构建具有DOM属性（createElement，setAttribute）的XML，而不是连接文本字符串。 XML不是一个文本文件，而是一个带有编码和树结构的标记文件。 VBA配备了MSXML对象，可以从Excel数据中迭代构建树，如下所示：

Excel 数据

FirstName   LastName    Age    Civility
Aaron       Adams       45     CIVILITY
Beatrice    Beaumont    39     CIVILITY
Clark       Chandler    28     CIVILITY
Debra       Devins      31     CIVILITY
Eric        Easterlin   42     CIVILITY

VBA 宏（构建XML树，然后使用XSLT进行精美打印）

Sub xmlExport()
On Error GoTo ErrHandle
    ' ADD Microsoft XML, v6.0 IN VBA References
    Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60
    Dim root As IXMLDOMNode, ydatasNode As IXMLDOMNode, yinstanceNode As IXMLDOMNode, languageNode As IXMLDOMElement
    Dim yinstanceAttrib As IXMLDOMAttribute, languageAttrib As IXMLDOMAttribute
    Dim clientNode As IXMLDOMElement, civilityNode As IXMLDOMElement
    Dim firstNameNode As IXMLDOMElement, lastNameNode As IXMLDOMElement, ageNode As IXMLDOMElement
    Dim clientAttrib As IXMLDOMAttribute, civilityAttrib As IXMLDOMAttribute
    Dim nmsp As String
    Dim i As Long

    ' DECLARE ROOT AND CHILDREN '
    nmsp = "http://www.test.com/engine/3"
    Set root = doc.createNode(NODE_ELEMENT, "y:input", nmsp)
    doc.appendChild root

    Set ydatasNode = doc.createNode(NODE_ELEMENT, "y:datas", nmsp)
    root.appendChild ydatasNode

    Set yinstanceNode = doc.createNode(NODE_ELEMENT, "y:instance", nmsp)
    ydatasNode.appendChild yinstanceNode
    Set yinstanceAttrib = doc.createAttribute("yid")
    yinstanceAttrib.Value = "theGeneralData"
    yinstanceNode.Attributes.setNamedItem yinstanceAttrib

    Set languageNode = doc.createElement("language")
    yinstanceNode.appendChild languageNode
    Set languageAttrib = doc.createAttribute("yid")
    languageAttrib.Value = "LANG_en"
    languageNode.setAttributeNode languageAttrib

    ' ITERATE CLIENT NODES '
    For i = 2 To Sheets(1).UsedRange.Rows.Count

        ' CLIENT NODE '
        Set clientNode = doc.createElement("client")
        yinstanceNode.appendChild clientNode

        Set clientAttrib = doc.createAttribute("yclass")
        clientAttrib.Value = "Client"
        clientNode.setAttributeNode clientAttrib

        ' FIRST NAME NODE '
        Set firstNameNode = doc.createElement("firstName")
        firstNameNode.Text = Range("A" & i)
        clientNode.appendChild firstNameNode

        ' LAST NAME NODE '
        Set lastNameNode = doc.createElement("lastName")
        lastNameNode.Text = Range("B" & i)
        clientNode.appendChild lastNameNode

        ' AGE NODE '
        Set ageNode = doc.createElement("age")
        ageNode.Text = Range("C" & i)
        clientNode.appendChild ageNode

        ' CIVILITY NODE '
        Set civilityNode = doc.createElement("civility")
        clientNode.appendChild civilityNode
        Set civilityAttrib = doc.createAttribute("yid")
        civilityAttrib.Value = toYID(Range("D" & i))
        civilityNode.setAttributeNode civilityAttrib

    Next i

    ' PRETTY PRINT RAW OUTPUT '
    xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
            & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
            & "                xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
            & "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
            & "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
            & "            encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
            & " <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _
            & "  <xsl:copy>" _
            & "   <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _
            & "  </xsl:copy>" _
            & " </xsl:template>" _
            & "</xsl:stylesheet>"

    xslDoc.async = False
    doc.transformNodeToObject xslDoc, newDoc
    newDoc.Save baseDirectory & projectName & "\xmlBatch\inputTest.xml"

    MsgBox "Successfully exported Excel data to XML!", vbInformation
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Exit Sub

End Sub

<强>输出

<?xml version="1.0" encoding="UTF-8"?>
<y:input xmlns:y="http://www.test.com/engine/3">
    <y:datas>
        <y:instance yid="theGeneralData">
            <language yid="LANG_en"></language>
            <client yclass="Client">
                <firstName>Aaron</firstName>
                <lastName>Adams</lastName>
                <age>45</age>
                <civility yid="CIVILITY"></civility>
            </client>
            <client yclass="Client">
                <firstName>Beatrice</firstName>
                <lastName>Beaumont</lastName>
                <age>39</age>
                <civility yid="CIVILITY"></civility>
            </client>
            <client yclass="Client">
                <firstName>Clark</firstName>
                <lastName>Chandler</lastName>
                <age>28</age>
                <civility yid="CIVILITY"></civility>
            </client>
            <client yclass="Client">
                <firstName>Debra</firstName>
                <lastName>Devins</lastName>
                <age>31</age>
                <civility yid="CIVILITY"></civility>
            </client>
            <client yclass="Client">
                <firstName>Eric</firstName>
                <lastName>Easterlin</lastName>
                <age>42</age>
                <civility yid="CIVILITY"></civility>
            </client>
        </y:instance>
    </y:datas>
</y:input>

Answer 2

您设置代码的方式，只需查看第一行即可。你需要为它添加一个循环来查看你所有的行（我假设你有＆＃39; n＆＃39;行数）。为此，您可以先使用以下内容获取行计数：

Dim intTotalRows as Integer : intTotalRows = Worksheets("<your worksheet name>").Cells(Rows.Count, "B").End(xlUp).Row

现在您已计算行数，请在FOR之前添加objStream.WriteText ("<client yclass='Client'>" & vbLf)循环，并在objStream.WriteText ("</client>" & vbLf)之后完成。这将循环遍历所有行。您的FOR循环可能类似于：

For intRow = 1 To intTotalRows

现在使用intRow更改您的行号。即：

objStream.WriteText ("  <firstName>" & Cells(intRow, 1).Text & "</firstName>" & vbLf)
objStream.WriteText ("  <lastName>" & Cells(intRow, 2).Text & "</lastName>" & vbLf)

希望这有帮助

Answer 3

输出

<?xml version='1.0' encoding='UTF-8'?>
<y:input xmlns:y='http://www.test.com/engine/3'>
  <y:datas>
      <y:instance yid='theGeneralData'>
<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>firstName</firstName>
  <lastName>lastName</lastName>
  <age>age</age>
  <civility yid='CIVILITY' />
</client>
<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>firstName</firstName>
  <lastName>lastName</lastName>
  <age>age</age>
  <civility yid='CIVILITY' />
</client>
<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>firstName</firstName>
  <lastName>lastName</lastName>
  <age>age</age>
  <civility yid='CIVILITY' />
</client>
<language yid='LANG_en' />
<client yclass='Client'>
  <firstName>firstName</firstName>
  <lastName>lastName</lastName>
  <age>age</age>
  <civility yid='CIVILITY' />
</client>
      </y:instance>
  </y:datas>
</y:input>

在这里我的剧本：

Sub createXML()

    Sheets("Sheet1").Select

    FullPath = baseDirectory & projectName & "\xmlBatch\inputTest.xml"

    Set objStream = CreateObject("ADODB.Stream")
    objStream.Charset = "iso-8859-1"

    objStream.Open
    objStream.WriteText ("<?xml version='1.0' encoding='UTF-8'?>" & vbLf)
    objStream.WriteText ("<y:input xmlns:y='http://www.test.com/engine/3'>" & vbLf)
    objStream.WriteText ("  <y:datas>" & vbLf)
    objStream.WriteText ("      <y:instance yid='theGeneralData'>" & vbLf)
    objStream.WriteText ("" & vbLf)
    objStream.WriteText ("<language yid='LANG_en' />" & vbLf)
    Dim intTotalRows As Integer: intTotalRows = Worksheets("Sheet1").Cells(Rows.Count, "B").End(x1Up).Row
    For intRow = 1 To intTotalRows
    objStream.WriteText ("<client yclass='Client'>" & vbLf)
    objStream.WriteText ("  <firstName>" & Cells(1).Text & "</firstName>" & vbLf)
    objStream.WriteText ("  <lastName>" & Cells(2).Text & "</lastName>" & vbLf)
    objStream.WriteText ("  <age>" & Cells(3).Text & "</age>" & vbLf)
    objStream.WriteText ("  <civility yid='" & toYID(Cells(4).Text) & "' />" & vbLf)
    objStream.WriteText ("</client>" & vbLf)
    Next intRow
    objStream.WriteText ("" & vbLf)
    objStream.WriteText ("      </y:instance>" & vbLf)
    objStream.WriteText ("  </y:datas>" & vbLf)
    objStream.WriteText ("</y:input>" & vbLf)

    objStream.SaveToFile FullPath, 2
    objStream.Close

End Sub

非常感谢

宏VBA Excel创建XML文件日期

3 个答案: