マクロ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プロパティ（createElement、setAttribute）でXMLを構築できます。 XMLはテキストファイルではなく、エンコーディングとツリー構造を持つマークアップファイルです。 VBAは、MSXMLオブジェクトが装備されていますと、以下のように反復的に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>

出典

2016-10-04 15:53:58 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)後にそれを終えます。これは、すべての行をループします。今intRowを使用して行番号を変更

For intRow = 1 To intTotalRows

：あなたのFORループのようになります。すなわち：

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

希望これは、ここでは、出力

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

、ここで私のスクリプトを

出典

2016-10-04 14:23:15 Zac

こんにちはザックさん、ありがとうございます。構造体xmlは正しく生成されますが、データは各クライアントで同じです。私は何か間違ったことをした？ –

更新されたコードを表示できますか？ – Zac

と結果 – Zac

を支援します。

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

私が疑っていたように、あなたはあなたの 'Cells'に' intRow'を追加しませんでした。私の答えの最後のビットを見てみましょう。これは、コードの 'Cells'ビット、すなわち' objStream.WriteText（ ""＆Cells（intRow、1）.Text＆ ""＆vbLf） ' – Zac

こんにちはザックを変更する方法の例です。どうもありがとう。すべてが完璧に動作します！ –

問題なく、うまくいきました。助けても答えを受け入れることを忘れないでください。 – Zac

マクロVBA ExcelはXMLファイルの日付を作成します

答えて

関連する問題