以下のマクロで複数シートをXMLファイルに出力したいのですが、出力こそ出来るものの、中身が空っぽのまま出力されてしまいます。
またDo While i < 13をDo While i < 5、とループさせずに一つのファイルだけ出力させるとこっちは中身がちゃんと入ったまま出力されます。
なぜ複数同時にやると空になるのでしょう・・。
また複数同時に出力する方法はあるのでしょうか?
よろしくお願いします。
Option Explicit Sub XML() Dim TargetWorkbook As Workbook Dim OpenFileName As String Dim x As String Dim y As String Dim i As Integer Dim Row As Integer Dim Col As Integer Dim SheetName As String Dim xmlObj As MSXML2.IXMLDOMNode Dim xmlObj1 As MSXML2.IXMLDOMNode Dim xmlObj2 As MSXML2.IXMLDOMNode Dim xmlObj3 As MSXML2.IXMLDOMNode Dim xmlObj4 As MSXML2.IXMLDOMNode Dim xmlDoc As MSXML2.DOMDocument60 Dim xmlPI As IXMLDOMProcessingInstruction Dim FileName As String Dim xmlReader As New SAXXMLReader Dim xmlWriter As New MXXMLWriter i = 4 OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") Do While i < 13 Set TargetWorkbook = Workbooks.Open(OpenFileName) If OpenFileName <> "False" Then Set xmlDoc = New MSXML2.DOMDocument60 Set xmlPI = xmlDoc.appendChild(xmlDoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8""")) Row = 3 Col = 2 SheetName = TargetWorkbook.Worksheets(i).Name Do While Col < 7 If TargetWorkbook.Worksheets(i).Cells(Row, Col).Value <> "" Then If Col = 2 Then x = TargetWorkbook.Worksheets(i).Cells(Row, 7).Value y = TargetWorkbook.Worksheets(i).Cells(Row, 9).Value Set xmlObj = xmlDoc.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) xmlObj.Text = y ElseIf Col = 3 Then x = TargetWorkbook.Worksheets(i).Cells(Row, 7).Value y = TargetWorkbook.Worksheets(i).Cells(Row, 9).Value Set xmlObj1 = xmlObj.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) xmlObj1.Text = y ElseIf Col = 4 Then x = TargetWorkbook.Worksheets(i).Cells(Row, 7).Value y = TargetWorkbook.Worksheets(i).Cells(Row, 9).Value Set xmlObj2 = xmlObj1.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) xmlObj2.Text = y ElseIf Col = 5 Then x = TargetWorkbook.Worksheets(i).Cells(Row, 7).Value y = TargetWorkbook.Worksheets(i).Cells(Row, 9).Value Set xmlObj3 = xmlObj2.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) xmlObj3.Text = y ElseIf Col = 6 Then x = TargetWorkbook.Worksheets(i).Cells(Row, 7).Value y = TargetWorkbook.Worksheets(i).Cells(Row, 9).Value Set xmlObj4 = xmlObj3.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) xmlObj4.Text = y End If Col = 2 Row = Row + 1 Else: Col = Col + 1 End If Loop If TargetWorkbook.Worksheets(i).Name = "a" Then FileName = "a.xml" ElseIf TargetWorkbook.Worksheets(i).Name = "b" Then FileName = "b.xml" ElseIf TargetWorkbook.Worksheets(i).Name = "c" Then FileName = "c.xml" ElseIf TargetWorkbook.Worksheets(i).Name = "d Then FileName = "d.xml" ElseIf TargetWorkbook.Worksheets(i).Name = "e" Then FileName = "e.xml" ElseIf TargetWorkbook.Worksheets(i).Name = "f" Then FileName = "f.xml" ElseIf TargetWorkbook.Worksheets(i).Name = "g" Then FileName = "g.xml" ElseIf TargetWorkbook.Worksheets(i).Name = "h" Then FileName = "h.xml" End If xmlWriter.indent = True Set xmlReader.contentHandler = xmlWriter xmlReader.Parse xmlDoc.XML xmlDoc.loadXml xmlWriter.output xmlDoc.Save (FileName) End If i = i + 1 Loop End Sub
回答3件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2018/03/27 13:06
2018/03/28 00:35
2018/03/28 00:46
2018/03/28 01:24