意外となんとかなる日記

世迷言を心に、綺麗事を頭に

スポンサーリンク

VBAでXMLファイルを作成する(XMLファイル出力)

 最近XMLが気になっています。ちょっとしたマイブームです。
 VBAでXMLファイルを1から作成するコードを遺しておきます。


Sub saveXml()
    ' Microsoft XML v6.0を使用
    ' 参照設定で「Microsoft XML, v6.0」にチェックを入れて下さい
    Dim xD As New MSXML2.DOMDocument60
    Dim nd(2) As MSXML2.IXMLDOMNode
    
    ' 親ノード作成
    Set nd(0) = xD.createNode(NODE_ELEMENT, "test", "")
    
    ' 1個目のノード作成
    Set nd(1) = xD.createNode(NODE_ELEMENT, "test1", "")
    nd(1).Text = "text1です"
    nd(0).appendChild nd(1)     ' 親ノードに1個目のノードを追加
    
    ' 2個目のノード作成
    Set nd(2) = xD.createNode(NODE_ELEMENT, "test2", "")
    nd(2).Text = "text2です"
    nd(0).appendChild nd(2)     ' 親ノードに2個目のノードを追加
    
    ' ルートノード作成
    xD.appendChild xD.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
    xD.appendChild nd(0)      ' ルートノードに親ノードを追加
    
    ' ファイルに保存
    xD.Save "D:\test.xml"
    
    Set xD = Nothing
End Sub

Sub loadXml()
    Dim xD As New MSXML2.DOMDocument60
    
    ' ファイルから読み込み
    xD.Load "D:\test.xml"
    
    ' 値取得方法1
    Debug.Print "Test Case 1"
    Debug.Print xD.DocumentElement.SelectSingleNode("test1").Text
    
    Debug.Print vbCrLf
    
    ' 値取得方法2
    Debug.Print "Test Case 2"
    For Each n In xD.getElementsByTagName("test").Item(0).ChildNodes
        Debug.Print n.nodeName & ":" & n.Text & vbCrLf
    Next
    
    Set xD = Nothing
End Sub

 出力結果
 f:id:Suechan:20151112164428j:plain

 動作確認はExcel2016で行いましたが、Excel2010、Excel2013、Access2010、Access2013、Access2016でも動作すると思います。
 また、参照ライブラリのところでMSXMLかMSXML2の違うときがありますが、どちらを指定してもよさそうです。

スポンサーリンク