EXCELVBA XML処理

質問

こんにちは、
下記のプログラムを作成したのですが、
（すいません、わかりづらいかもしれません。）
<DIMENSION Name="E1">内の<HIERARCHY>タグ内にある
<PARENT>と<CHILD>の値をセルに貼り付けようとしているのですが、
現在、下記二点で悩んでいまして、何か方法などありましたらお願い致します。
1：<DIMENSION Name="E1">処理のときに、セルにNAMEの値Ｅ１を出力
　しているのですが、二回表示されてしまう。
　（おそらく、<MEMBERS>と<HIERARCHY>と二つタグがあるので
　そのせいかと思ったのですが、回避方法が変わりません。）
2：<DIMENSION Name="Ｅ1">だけでよいのだが、
　<DIMENSION Name="Z1">まで処理を行っている
　（<DIMENSION Name="Ｅ1">を抜けたという判断方法がわからず・・）

ＶＢＡコード-----------
Option Explicit
Dim ia As Long
Dim flg As Integer
Private Sub CommandButton2_Click()
Const cnsTITLE = "テキストファイル読み込み処理"
Const cnsFILTER = "全てのファイル (*.*),*.*"
Dim xlAPP As Application ' Applicationオブジェクト
Dim strXMLFile As String
Dim objDOM As MSXML2.DOMDocument
Dim rtResult

Set xlAPP = Application
xlAPP.StatusBar = "読み込むファイル名を指定して下さい。"
strXMLFile = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, _
Title:=cnsTITLE)
If StrConv(strXMLFile, vbUpperCase) = "FALSE" Then Exit Sub

Set objDOM = New MSXML2.DOMDocument
rtResult = objDOM.Load(strXMLFile)
If rtResult = True Then
ia = 0
flg = 0
procDispDatas objDOM.childNodes
Else
MsgBox "読み込み失敗"
End If
Set objDOM = Nothing
End Sub

Sub procDispDatas(objNode)
Dim obj
For Each obj In objNode
If (obj.parentNode.nodeName = "DIMENSION") Then
'<DIMENSION >タグ内処理か判断
If (obj.parentNode.Attributes.getNamedItem("Name").nodeValue = "E1") Then
'<DIMENSION Name="E1">タグ内処理か判断
ia = ia + 1
Cells(ia, 1).Value = _
obj.parentNode.Attributes.getNamedItem("Name").nodeValue & " : "
flg = 1
End If
ElseIf (flg = 1) Then
If (obj.parentNode.nodeName = "HIERARCHY") Then
'<HIERARCHY>タグ内処理か判断
flg = 2
End If
ElseIf (flg = 2) Then
If (obj.parentNode.nodeName = "NODE") Then
'<NODE>タグ内処理か判断
flg = 3
End If
ElseIf (flg = 3) Then
Select Case obj.parentNode.nodeName
Case "PARENT" '<PARENT>タグ内処理か判断
ia = ia + 1
Cells(ia, 1).Value = _
obj.parentNode.nodeName & " : " & _
obj.nodeValue
Case "CHILD" '<CHILD>タグ内処理か判断
ia = ia + 1
Cells(ia, 1).Value = _
obj.parentNode.nodeName & " : " & _
obj.nodeValue
Case Else
End Select
End If

If obj.hasChildNodes Then
procDispDatas obj.childNodes
End If
Next
End Sub

ＸＭＬファイル----------
<?xml version = "1.0" encoding="UTF-16" ?>
<HSDATA>
<DIMENSION Name="E1">
<MEMBERS>
<MEMBER>
<LABEL>[None]</LABEL>
<AT Name="DefCurrency">[None]</AT>
<DESCRIPTION Language="English">[None]</DESCRIPTION>
</MEMBER>
</MEMBERS>
<HIERARCHY>
<NODE>
<PARENT>#root</PARENT>
<CHILD>[None]</CHILD>
</NODE>
<NODE>
<PARENT>#root</PARENT>
<CHILD>MNG_CN</CHILD>
</NODE>
</HIERARCHY>
</DIMENSION>

<DIMENSION Name="Z1">
<HIERARCHY>
<NODE>
<PARENT>abc</PARENT>
<CHILD>123</CHILD>
</NODE>
<NODE>
<PARENT>def</PARENT>
<CHILD>456</CHILD>
</NODE>
</HIERARCHY>
</DIMENSION>
</HSDATA>

回答No.2

redfox63 · ベストアンサー

2回表示されるのは DIMENSION/HIERARCY に NODEが2要素あるためですよ
自分で探すより XMLに探させたほうが間違いないのでは ・・・

Sub procDispDatas(objNode, Optional rg as Range = Nothing)
　　Dim obj as IXMLDomNode, ss as String
　　ss = ""
　　On Error Resume Next
　　ss = objNode.Attributes.getNamedItem("Name").nodeValue
　　On Error goto 0
　　if ss = "" then
　　　　' DIMENSION/HIERARCY/NODEの場合
　　　　dim obj1 as IXMLDomNode
　　　　' 子要素の PARENTとCHILDを取得
　　　　for each obj1 in obj.childNode
　　　　　　rg.Offset(0,0).Value = obj1.baseName
　　　　　　rg.Offset(0,1).Value = obj1.Text
　　　　　　set rg = rg.Offset(,1)
　　　　next
　　else if ss = "E1" then
　　　　' <DIMENSION Name="E1"> ... </DIMENSION>"の場合
　　　　if rg is Nothing then
　　　　　　' C1は適宜修正してください
　　　　　　set rg = Range("C1")
　　　　end if
　　　　rg.Value = ss
　　　　' 子ノードを D,E列に転記
　　　　Set rg = rg.Offset( , 1 )
　　　　' ノードの子ノードをXMLで選別
　　　　procDispDatas obj.selectNodes("HIERARCY/NODE"),rg
　　end if
End Sub

呼び出し方を
procDispDatas objDOM.getElementsByTagName("DIMENSION")
とします
これで DIMENSIONノード以外は procDispDatasに渡りません

回答No.1

kenpon24

xmlに明るくないので詳しくはわかりませんが、
Debug.print obj.parentNode.nodeNameで確認した限り
</MEMBER>
</MEMBERS>
のを通過するあたりで <DIMENSION Name="E1">が参照されているように思えます。
obj.parentNode.nodeNameにDIMENSIONが格納されている)

同様に
</NODE>
</HIERARCHY>
</DIMENSION>
を通過するあたりではHSDATAが格納されています。

(1)の対策は色々あると思いますが、入力済みフラグを作るのはどうですか？
procDispDatas内で
Dim InputFlg as Boolean
として入力したらフラグを立てる。

入力済みなら2度は書き込まない。

(2)の対策としては、
If (obj.parentNode.Attributes.getNamedItem("Name").nodeValue = "E1") Then
のElse条件をつくり、Flg = 3だったらExit forするとか。
実際に処理する単位はもっと巨大でしょうから、もう少しすっきりした書き方を
したいところではありますね。。。

とりあえずこんなところでどうですか？