宏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文件日期

回答

相關問題