宏VBA Excel创建XML文件日期

与Excel中的宏VBA我需要在excel文件中的1张转换日期。为此，我已经创建了一个脚本，但我有问题要在xml中正确生成日期我需要第一行标题，然后公式读取所有包含数据的行。宏VBA Excel创建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>

来源

2016-10-04 Massimiliano Mascoli

什么问题？代码输出正确，据我所知。 – Andreas

我的问题是，我的脚本在XML文件数据不为客户端1,2,3 ..等创建一个新的标签正如你在第二个输出，我会得到的。我如何制作一个读取所有行的循环，同时为每行创建一个新标签？ –

对不起，我现在没有时间回答，我必须回家。 – Andreas

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

Excel中用XSLT数据

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树，然后漂亮打印）

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>

来源

2016-10-04 15:53:58 Parfait

哇非常非常感谢Parfait！ –

f我会开始创建从第4行的Excel中的所有数据我该如何设置？你也认为有可能有Client1，Client2等。？ –

更改循环条目：'For i = 2'到'For i = 4'。并简单地将一个迭代器连接到客户机节点名称：'Set clientNode = doc.createElement（“client”＆i - 3）'。 – Parfait

你有你的代码设置的方式，它所做的就是查看第一行。你需要添加一个循环来查看你的所有行（我假设你有'n'行数）。要做到这一点，你可以先使用类似得到行数：

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

现在，你有你的行数，只是objStream.WriteText ("<client yclass='Client'>" & vbLf)之前添加FOR环和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)

希望这有助于

来源

2016-10-04 14:23:15 Zac

嗨Zac谢谢。 xml结构正确生成，但每个客户端的数据都是相同的。我做错了什么？ –

你能显示更新的代码吗？ – Zac

和结果 – Zac

这里输出

<?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

非常感谢

来源

2016-10-04 15:08:12

正如我怀疑的那样，您没有将'intRow'添加到'Cells'中。看看我的答案中最后一段代码。它提供了一个如何改变'Cells'位代码的例子，例如'objStream.WriteText（“”＆Cells（intRow，1）.Text＆“”＆vbLf）' – Zac

Hi Zac！非常感谢。 Everythings作品完美！ –

没问题，很高兴它的工作。请不要忘记接受答案，如果它帮助 – Zac

宏VBA Excel创建XML文件日期

回答

相关问题