みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

EXCELVBA XML処理

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

VBAコード-----------
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ファイル----------
<?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>

投稿日時 - 2009-04-23 10:19:32

QNo.4902226

困ってます

質問者が選んだベストアンサー

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に渡りません

投稿日時 - 2009-04-23 16:15:43

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

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するとか。
実際に処理する単位はもっと巨大でしょうから、もう少しすっきりした書き方を
したいところではありますね。。。

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

投稿日時 - 2009-04-23 15:52:27

あなたにオススメの質問