質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.07%

XML一括出力 なぜでない

解決済

回答 3

投稿

  • 評価
  • クリップ 0
  • VIEW 1,042

sigret

score 45

以下のマクロで複数シートを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
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 3

checkベストアンサー

+2

まずコードの書き方から、
・TargetWorkbook.Worksheets(i) → Withを使って省略しましょう
・If TargetWorkbook.Worksheets(i).Name = "a" Then ・・・ → Select Case を使いましょう
※SheetNameを使わない理由はあるのでしょうか?

正しい処理は分かりませんが、状況から
「xmlDoc.Save (FileName)」の後に、Close や Nothing 処理は不要なのでしょうか?

また、「FileName = "h.xml"」等としてますが、
パスを指定しない場合は確かマイドキュメントへ自動的に保存されますが、
分かりにくいので、ThisWorkBook.Path & "\" & FileName 等でちゃんとパスを指定すべき。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/03/27 22:06

    ExcelVBAさん
    回答ありがとうございます。
    コードの書き方については完成ののち(とりあえず出力できることが確認できてから)対応したいと思います。

    Close や Nothing の処理なのですがCloseはClose処理をすると(.Closeを追記)エラーが出てしまいます・・。
    Nothing 至っては何をNothing にすればいいのかわからず・・取り合えず思いつくままに(xmlDoc、FileName など)片っ端からNothing で構文を入れてみたのですがやはり中身が空で出力されます・・。

    先輩曰く何か初期化ができていない?そうなのですが自分としては変数は全て初期化できている(つもり)です・・。

    キャンセル

  • 2018/03/28 09:35

    プロの料理人が料理している間にキッチンがグチャグチャになるでしょうか?

    コードを簡潔にすることを後回しにする人が、いい仕事できるんでしょうか?

    個人的には一時的な書き方をした場合でも動くようになったら即修正と決めています。
    なぜなら、後回しにしていくと面倒になってそのままにしがちだからです。

    そうすると、テストフェーズでバグが見つかった時に、
    コードが読み難く、修正に手間がかかります。

    そして往々にして、適当に作った箇所でバグが見つかる事を、
    何回も経験して分かってます。

    なので、原因追及が困難な今だからこそ、
    息抜きついでに合間にできることは先にやっておく方がいいと思います。

    ※改善点の追加です
    単純にシートを回しているのであれば、Do~Loop ではなく、For~Next の方が適しています。
    コードは正確に、簡潔に。
    これを常日頃から実践していくと、
    不要なバグに悩まされる事が少なくなりますよ。学生さん。

    キャンセル

  • 2018/03/28 09:46

    なるほど・・。自分が元調理師だったのでその喩はすごく良く分かります。
    汚く散らかしていたらブチ切れものでしたし(笑)

    何においてもそうなんですね。精進します!

    キャンセル

  • 2018/03/28 10:24

    おぉ、まさかの回答でビックリ!!
    他の業界でも通じるところがあるもんですね~(笑)

    とあるイベントでプロ調理師のお手伝いをする機会があり、
    片付ける事の重要さを教えてもらった事が役に立ったみたいです.

    折角なので、参考コードを少し(※インデントは調整してください)

    Dim TargetSheet As WorkSheet
    Set TargetSheet = TargetWorkbook.Worksheets(i)
    With TargetSheet
    Select Case .Name
    Case "a" : FileName = "a.xml"
    End Select
    End With

    キャンセル

0

試せる環境にいないので推測ですが、createElementしていないのにノードだけ追加されているのでxmlとしての構造が整わず、空出力となる?
MSXML2におけるノードとエレメントの考えは調べれば出てくると思います

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/03/28 08:52

    Satou0317さん
    回答ありがとうございます。
    しかし一枚目(複数出力時の最初の一回)はちゃんと出力されることから構造自体は間違ってはないのでは、と考えられます・・。
    createElementに関してももう一度調べなおしてみます。
    ありがとうございます!

    キャンセル

0

 結論

xmlWriterなどをループ毎に初期化する。

 デバッグの過程

xmlDoc.xmlをウォッチ式で追ったところ、xmlDoc.LoadXML xmlWriter.outputで空文字列となりました。

xmlWriter.outputを確認したところ、ループ毎に<?xml version="1.0" encoding="UTF-16" standalone="no"?>が増えており、2回目以降は適当なXMLではなくなったのが、空出力の原因だと思われます。

 その他粗探し

ExcelVBAer さんも指摘されていますが、ちょっと読みにくいコードです。

読みにくいとバグが混入しやすいだけでなく、回答側の精神的ハードルも上がるため、回答が少なくなる、遅くなる可能性があります
(私も昨日の時点で質問に気付いていましたが、コードの整理が面倒だったため後回しにしました)。


以下の処理はループの外に出しましょう。
また、If文は前に持ってこないと意味がありません。
Ifの判定の結果、"False"であれば即座にExit Subすると、以降のネストを一段減らせます。

Set TargetWorkbook = Workbooks.Open(OpenFileName)
    If OpenFileName <> "False" Then

中央、列番号のIf文内の以下の処理が重複していますので、Ifの外に出した方が見やすくなります。

x = TargetWorkbook.Worksheets(i).Cells(Row, 7).Value
y = TargetWorkbook.Worksheets(i).Cells(Row, 9).Value

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.07%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る