• 締切済み

VBSでXMLを読込、検索結果をテキスト出力

VBSのソースについてご教授下さい。 【作りたい機能】 XMLファイルを読み込み、任意のエレメントを検索するスクリプトを VBSで作成しようとしています。 【状況】 ダイアログで表示させる方法はわかりました。  参照  http://www.atmarkit.co.jp/fxml/rensai/msxml01/msxml03.html 01 : Dim objDOM, rtResult 02 : 03 : Set objDOM = WScript.CreateObject("MSXML2.DOMDocument") 04 : rtResult = objDOM.load("Sample.xml") 05 : If rtResult = True Then 06 : procDispDatas objDOM.childNodes 07 : End If 08 : Set objDOM = Nothing 09 : 10 : Sub procDispDatas(objNode) 11 : Dim obj 12 : For Each obj In objNode 13 : If obj.nodeType = 3 and obj.parentNode.nodeName = "title" Then 14 : MsgBox obj.parentNode.nodeName & " : " & obj.nodeValue 15 : End If 16 : If obj.hasChildNodes Then 17 : procDispDatas obj.childNodes 18 : End If 19 : Next 20 : End Sub この結果をテキストファイルに出力させる方法に 困っております。 どこにどのように記載すればいいか 教えていただきたく存じます。 よろしくお願いいたします

みんなの回答

  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.1

手元にあったxmlファイルに合わせてprocDispDatasの方はアレンジさせていただいておりますが、 下記の様な感じでテキストファイルに書き出せると存じます。ご参考まで。 Dim objDOM, rtResult Dim objFSO Dim objTextStream Set objDOM = WScript.CreateObject("MSXML2.DOMDocument") Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") Set objTextStream = objFSO.CreateTextFile("C:\writeXmlValue.txt") rtResult = objDOM.Load("C:\hoge.xml") If rtResult = True Then procDispDatas objDOM.childNodes End If Set objDOM = Nothing objTextStream.Close Set objTextStream = Nothing Set objFSO = Nothing Sub procDispDatas(objNode) Dim obj For Each obj In objNode If obj.nodetype = 1 And obj.nodename = "??????" Then objTextStream.writeline obj.Text End If If obj.hasChildNodes Then procDispDatas obj.childNodes End If Next End Sub

関連するQ&A

  • VBScriptでXMLのデータを取得する方法

    こんにちは。 プログラミング初心者です。どうぞよろしくお願いします。 VBSで下記のようなXMLのtitleをpub idごとに別々に分けて抽出したいのですが、どうしたらよいか全く分からない状態です。 <book> <publisher> <pub id="集英社"/> </publisher> <title>ドラゴンボール</title> </book> <book> <publisher> <pub id="講談社"/> </publisher> <title>はじめの一歩</title> </book> <book> <publisher> <pub id="集英社"/> </publisher> <title>ジョジョの奇妙な冒険</title> </book> <book> <publisher> <pub id="秋田書店"/> </publisher> <title>範馬刃牙</title> </book> 下記のリンク先サイトにあったコードを試したのですが、titleが一緒くたに抽出されてしまい、別々に抽出ができません。pub idの階層が一つ深いのが原因だと思うのですが・・・どうしたらよいのか、さっぱり思いつきません。 http://www.atmarkit.co.jp/fxml/rensai/msxml01/msxml03.html Dim objDOM, rtResult Set objDOM = WScript.CreateObject("MSXML2.DOMDocument") rtResult = objDOM.load("○○.xml") If rtResult = True Then procDispDatas objDOM.childNodes End If Set objDOM = Nothing Sub procDispDatas(objNode) Dim obj For Each obj In objNode If obj.nodeType = 3 and obj.parentNode.nodeName = "title" Then MsgBox obj.parentNode.nodeName & " : " & obj.nodeValue End If If obj.hasChildNodes Then procDispDatas obj.childNodes End If Next End Sub どうかアドバイスをよろしくお願いいたします!

  • VBAでxmlから特定の文字を変数に入れたい

    VBAからXMLを取得したくて方法を検索し、以下のコードで何とか取得ができました。 Sub httpRequest() Dim HttpReq As MSXML2.XMLHTTP Dim DomDoc As MSXML2.DOMDocument Dim targetURL As String targetURI = "http://www.drk7.jp/weather/xml/14.xml" 'HTTP GET Set HttpReq = CreateObject("MSXML2.XMLHTTP") HttpReq.Open "GET", targetURI, False HttpReq.send (Null) 'XML PARSE Set DomDoc = CreateObject("MSXML2.DOMDocument") DomDoc.LoadXML (HttpReq.responseText) dumpDomDoc DomDoc.ChildNodes Set HttpReq = Nothing Set DomDoc = Nothing End Sub Sub dumpDomDoc(objNode) Dim obj For Each obj In objNode MsgBox obj.ParentNode.nodeName & " : " & obj.NodeValue If obj.HasChildNodes Then dumpDomDoc obj.ChildNodes End If Next End Sub このコードですと、読み込んだXMLを一行づつメッセージボックスに延々と表示するだけなのですが、 例えば行先のXMLファイルにある<description>と</description>に囲まれた部分だけを変数に格納するにはどのように記述すればよろしいのでしょうか? ググってはみましたが知識不足の為、解説も理解できず困っております。 大変お手数ですがご教示いただけますようお願いします。

  • VBScriptを用いたXMLのデータ抽出に関して

    下記のsample.xmlから sample.xml ---------------------------------------------- <?xml version="1.0" encoding="utf-8" ?> <books> <item> <title>XML入門-第1巻</title> <price>2500</price> <isbn>1-1234-5678-X</isbn> <authors> <author>西谷 亮</author> </authors> <imgfile>1-1234-5678-X.gif</imgfile> </item> <item> <title>XML入門-第2巻</title> <price>2200</price> <isbn>1-1234-5678-0</isbn> <authors> <author>西谷 亮</author> <author>山田 太郎</author> </authors> <imgfile>1-1234-5678-0.gif</imgfile> </item> <item> <title>XML入門-第3巻</title> <price>3600</price> <isbn>1-1234-5678-1</isbn> <authors> <author>西谷 亮</author> <author>鈴木 次郎</author> </authors> <imgfile>1-1234-5678-1.gif</imgfile> </item> </books> ---------------------------------------------- 下記のtitle.vbsを用いて、「<title>」タグに表記された 書物のタイトルだけを抜き出します。 title.vbs ---------------------------------------------- 01 : Dim objDOM, rtResult 02 : 03 : Set objDOM = WScript.CreateObject("MSXML2.DOMDocument") 04 : rtResult = objDOM.load("Sample.xml") 05 : If rtResult = True Then 06 : procDispDatas objDOM.childNodes 07 : End If 08 : Set objDOM = Nothing 09 : 10 : Sub procDispDatas(objNode) 11 : Dim obj 12 : For Each obj In objNode 13 : If obj.nodeType = 3 and obj.parentNode.nodeName = "title" Then 14 : MsgBox obj.parentNode.nodeName & " : " & obj.nodeValue 15 : End If 16 : If obj.hasChildNodes Then 17 : procDispDatas obj.childNodes 18 : End If 19 : Next 20 : End Sub ---------------------------------------------- 上記の記述ではサブプロシージャprocDispDatas(objNode) にて、<title>タグの要素の数だけMsgBoxでタイトル名の メッセージボックスが表示されるかと思います。 これをひとつのメッセージでまとめるて表示するはどのように 記述すればよいでしょうか。 下記のメッセージの表示が理想です。 メッセージ ---------------------------------------------- title:XML入門-第1巻 title:XML入門-第2巻 title:XML入門-第3巻 ---------------------------------------------- お手数をおかけしますが、ご存知の方 ご教授いただけませんでしょうか>< よろしくお願いいたします。

    • 締切済み
    • XML
  • 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>

  • XMLをエクセルに取り込むマクロその2

    以下のtest2.xmlを <?xml version="1.0" encoding="UTF-8" ?> <McXMLRoot> <McXMLData> <McXMLPageInfo> <page>1</page> <overLay></overLay> <partition>PAGE</partition> </McXMLPageInfo> <McXMLPageData> <現頁> <value>0001</value> </現頁> <作成日付> <value>平成21年 6月 1日現在</value> </作成日付> <Group0001> <氏名> <value>あああ</value> </氏名> <生年月日> <value>昭和48年 2月21日</value> </生年月日> </Group0001> <Group0002> </Group0002> <Group0003> </Group0003> </McXMLPageData> <McXMLPageInfo> <page>2</page> <overLay></overLay> <partition>PAGE</partition> </McXMLPageInfo> <McXMLPageData> <現頁> <value>0004</value> </現頁> <作成日付> <value>平成21年 6月 1日現在</value> </作成日付> <Group0001> <氏名> <value>いいい</value> </氏名> <生年月日> <value>昭和55年 12月5日</value> </生年月日> </Group0001> <Group0002> <法人名> <value>AAA株式会社</value> </法人名> <住所> <value>AA市1丁目1番地</value> </住所> </Group0002> <Group0003> <支店名> <value>BBB営業所</value> </支店名> </Group0003> </McXMLPageData> </McXMLData> </McXMLRoot> を読むマクロ↓ Public Const XmlPass = "D:\temp\test2.xml" Public y As Integer Public ctr As Long Public Sub Auto_Open() 'On Error Resume Next Workbooks.OpenXML Filename:= _ XmlPass _ , LoadOption:=xlXmlLoadImportToList Range("A1").Select Call RetsuSakujo Call parseXML End Sub Private Sub RetsuSakujo() ctr = 1 Do Until "" = Trim(Worksheets("sheet1").Cells(1, ctr)) If "eform" = Trim(Worksheets("sheet1").Cells(1, ctr)) Or _ "page" = Trim(Worksheets("sheet1").Cells(1, ctr)) Or _ "overLay" = Trim(Worksheets("sheet1").Cells(1, ctr)) Or _ "partition" = Trim(Worksheets("sheet1").Cells(1, ctr)) Then Worksheets("sheet1").Columns(ctr).EntireColumn.Delete ctr = 0 End If ctr = ctr + 1 Loop End Sub Private Sub parseXML() Dim objDOM, rtResult y = 1 Set objDOM = CreateObject("MSXML2.DOMDocument") rtResult = objDOM.Load(XmlPass) If rtResult = True Then Call setTitle(objDOM.childNodes) End If Set objDOM = Nothing End Sub Sub setTitle(objNode) Dim obj For Each obj In objNode If obj.hasChildNodes Then If obj.parentNode.nodeName <> "McXMLRoot" And _ obj.parentNode.nodeName <> "McXMLData" And _ obj.parentNode.nodeName <> "McXMLPageData" And _ obj.parentNode.nodeName <> "McXMLPageInfo" _ Then If SearchChild(obj.childNodes) = False Then If y >= ctr Then Exit Sub End If Cells(1, y).Value = obj.parentNode.nodeName y = y + 1 End If End If Call setTitle(obj.childNodes) End If Next End Sub Private Function SearchChild(objNode) As Boolean Dim obj For Each obj In objNode If obj.hasChildNodes Then SearchChild = True Else SearchChild = False End If Next End Function を作成してエクセルマクロを試したところ、 タイトルが 現頁,作成日付,氏名,生年月日,現頁2,作成日付2,氏名2,生年月日2,法人名 となります。が、本当は 現頁,作成日付,氏名,生年月日,法人名,住所,口座番号,口座名義人,支店名 としたいのです。(エクセルでXMLソースを表示した時の順序) なにかよい方法があれば教えてください。 よろしくお願いします。

  • VBA でxmlの全要素・属性の読み込み

    お世話になります。 ExcelのVBAを使用して、xmlファイルの全要素・全属性を読み込み、 Excelに書き出したいと思っております。 ネットを参考に下記のソースで、全ての要素をエクセルに 書き出すことは、できたのですが、どうしても全属性を読み込むことが できません。 どのようにすればよいか教えて頂けないでしょうか? お手数ですがよろしくお願い致します。 -----------------ソース---------------- Sub main() Dim myxml As New DOMDocument40 Dim nodelist As IXMLDOMNodeList Dim onenode As IXMLDOMNode Dim i As Integer myxml.Load ("C:\Users\harada\Desktop\problem_info取り込み\problem_info.xml") Set nodelist = myxml.DocumentElement.ChildNodes i = 1 For Each onenode In nodelist Call submain(onenode, i, 1) i = i + 1 Next End Sub Sub submain(tmp As IXMLDOMNode, itmp As Integer, j As Integer) If tmp.HasChildNodes = False Then Exit Sub k = tmp.ChildNodes.Length For m = 0 To k - 1 Cells(itmp, j + m).Value = tmp.ChildNodes(m).Text Next j = j + m Set tmp = tmp.ChildNodes.NextNode Call submain(tmp, itmp, j) End Sub

  • VB.NETでXMLの読み込みを行うと例外エラーが出てしまい大変困って

    VB.NETでXMLの読み込みを行うと例外エラーが出てしまい大変困っています。どなたかお願いします。 Protected Sub Button4_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button4.Click Dim FILENAME As String FILENAME = "C:\\TEST\" If i = 1 Then FILENAME = FILENAME & "AAA\111.xml" Call testmethod(FILENAME) ElseIf i = 2 Then FILENAME = FILENAME & "BBB\222.xml" Call testmethod(FILENAME) End If End Sub Private Sub testmethod(ByVal FILENAME) If File.Exists(FILENAME) Then Dim xlr As XmlTextReader xlr = New XmlTextReader(FILENAME) While xlr.Read() Select Case xlr.LocalName Case "Personal" TextBox1.Text = xlr.ReadString Case "LastUpdate" Label1.Text = xlr.ReadString End Select End While xlr.Close() End If End Sub こんな感じでコードを書いているのですがWhile xlr.Read()のところで例外エラーが出てしまいます。 原因が全然つかめず困っています。 New XmlTextReader(FILENAME)のFILENAMEを変数でなく直接パスを書くとうまくいくのですが変数にするとなぜかハンドリングできなくなります。 どなたかご解説お願いします。

  • xmlのデータ取得方法について

    WshでXMLの取り込みをしているのですが、あるタグにくるとエラーが出ます。 どのように処理をすればよろしいのでしょうか? ■ ソース(抜粋) objNode.Load("ファイル名") For Each tmp In objNode.getElementsByTagName("東京都") For Each tmp2 In tmp.ChildNodes If tmp2.hasChildNodes Then For Each tmp3 In tmp2.getElementsByTagName("新宿区") For Each tmp4 In tmp3.ChildNodes If tmp4.nodeName = "AAA" Then n1 = tmp4.firstChild.nodeValue End If If tmp4.nodeName = "BBB" Then n2 = tmp4.firstChild.nodeValue End If Next Next End If Next Next ■ XMLデータ <東京都> <新宿区> <AAA> "大人の町" </AAA> <BBB /> <----------この形式のタグでエラーが出ます。 </新宿区> </東京都> <BBB />は、値が無いので、firstChildではエラーになるみたいです。("tmp4.firstChildはオブジェクトがありません。"とでます。) 以上ご教授よろしくお願いします。

  • XMLの要素の内容の中に要素

    VisualBasic6.0にて、XMLを作成するプログラムを作っています。 XMLの作成、編集はMSXMLを使用しており、編集保存はできたのですが、下記のような要素の出力の仕方がわかりません。 <Node1>  あいうえお  <Node1-1>abcde</Node1-1>  かきくけこ </Node1> このように要素の文字列の途中に子要素を作成したいです。 「Node1」要素に、子要素「Node1-1」を追加するサンプルです。 Cドライブ直下に以下の内容のXMLファイル「test.xml」を作成 <?xml version="1.0" encoding="shift_jis"?> <Node1> </Node1> VB6にて、参照設定に「Microsoft XML V6.0」を追加し以下のコードを作成。 Private Sub Command1_Click() Dim xDoc As MSXML2.DOMDocument Set xDoc = New MSXML2.DOMDocument Dim node As IXMLDOMNodeList Dim Addnode As IXMLDOMNode Dim obj As IXMLDOMNode If xDoc.Load("C:\test.xml") Then Set node = xDoc.documentElement.selectNodes("/Node1") For Each obj In node Set Addnode = obj.appendChild(xDoc.createNode(NODE_ELEMENT, "Node1-1", "")) Addnode.Text = "abcde" Next xDoc.save ("C:\test.xml") End If Set xDoc = Nothing End Sub

  • VBSでXMLを操作したい

    現在Webアプリケーションの簡単なものを作成しています。 データベースはXMLで出来上がっているのでそれを使いたいのですが、入力フォームに入れてもらったデータをXMLに変換してXMLデータベースに追加、保存しようと思います。 一応フォームに入力したものをXMLデータとして出力までは考えられたのですが、既存のXMLを読み出す方法と追加する方法、保存する方法がよくわかりません。 よろしくお願いいたします。 <html> <head> <title>入力フォーム</title> <script type="text/vbscript"> <!-- Option Explicit dim xmldoc Sub window_onload() set xmldoc=createObject("MSXML2.DOMDocument") xmldoc.async=False xmldoc.loadXML("<?xml version='1.0'?><全体/>") End Sub Sub makeXml() dim myInfoElement,myDataElement,myDataText dim ret1,ret2,ret3,ret4 set ret1=xmldoc.createTextNode(vbCRLf) xmldoc.documentElement.appendChild(ret1) set myInfoElement=xmldoc.createElement("名簿") set ret2=xmldoc.createTextNode(vbCRLf) myInfoElement.appendChild(ret2) set myDataElement=xmldoc.createElement("名前") set myDataText=xmldoc.createTextNode(myForm.myName.value) myDataElement.SetAttribute "年",myForm.myAge.Value myDataElement.appendChild(myDataText) myInfoElement.appendChild(myDataElement) set ret3=xmldoc.createTextNode(vbCRLf) myInfoElement.appendChild(ret3) xmldoc.documentElement.appendChild(myInfoElement) set ret4=xmldoc.createTextNode(vbCRLf) xmldoc.documentElement.appendChild(ret4) myForm.xmlSource.value=xmldoc.xml End Sub --> </script> </head> <body> <form name="myForm"> 名前:<input type="text" size="30" name="myName"><br> 年:<input type="text" size="10" name="myAge"> <button onClick="makeXml()">XMLの作成</button><br> <textarea name="xmlSource" cols="60" rows="15"></textarea> </form> </body> </html>

専門家に質問してみよう