はじめに

こんかいはVBAの記事になります。

みんな大好きVBA(Visual Basic for Applications)はエクセルに標準搭載のプログラム言語になります。皆さんもマクロ記憶などで業務の自動化を行なったりしているかと思います。

そんな、身近な言語を使用してWebサービスにアクセスして情報を引き出していこうと思います。具体的には気象庁が発行している気象情報のXMLデータを表示するマクロになります。

一度登録すれば仕事の合間にお天気情報が見れるのでやや便利です。

※参考XML情報：https://www.drk7.jp/weather/

MSXMLの設定
VBAコード
おわりに

MSXMLの設定

VBAでXMLファイルを操作するにはMSXMLオブジェクトというXMLデータを操作する何かを設定する必要があります。設定方法は以下のとおりです。

1.エクセルの【開発】タブより【Visual Basicを開く】

2.【ツール】から【参照設定】を開く

3.【Microsoft XML. v6.0】にチェックを入れてOKを押す

VBAコード

Public Sub sample1()
    Dim XMLDocument As MSXML2.DOMDocument
    Dim xmlDate As IXMLDOMNode
    Dim xmlDate2 As IXMLDOMNode
    Dim xmlDate3 As IXMLDOMNode
    Dim time As IXMLDOMNode
    Dim childnode As IXMLDOMNode
    Dim childnode2 As IXMLDOMNode
    Dim xmlarry() As IXMLDOMNodeList
    Dim node As IXMLDOMNode
    Dim memberAttribute As MSXML2.IXMLDOMAttribute
    Dim memberList() As String
    Dim menberList2() As String
    Dim temp() As String
    Dim element As Long
    Dim i As Integer
    Dim msg As String, msg2 As String, msg3 As String
    
On Error GoTo ERROR_

    'MSXMLオブジェクトを生成し、xmlファイルをロード
    Set XMLDocument = New MSXML2.DOMDocument
    XMLDocument.async = False
    XMLDocument.Load ("https://www.drk7.jp/weather/xml/13.xml")
    If (XMLDocument.parseError.ErrorCode <> 0) Then 'ロード失敗
        Debug.Print XMLDocument.parseError.reason   'エラー内容を出力
        GoTo ERROR_
    End If
    
    
    'ノードの情報を取得
    Set xmlDate = XMLDocument.SelectSingleNode("//weatherforecast/pubDate")
    Set xmlDate2 = XMLDocument.SelectSingleNode("//temperature")
    Debug.Print xmlDate.Text
    Debug.Print xmlDate2.Text
    element = xmlDate2.ChildNodes.Length - 1
    ReDim temp(element)
    i = 0
    For Each xmlDate3 In xmlDate2.ChildNodes
        temp(i) = xmlDate3.Text
        i = i + 1
    Next xmlDate3
        
        
    'メンバーノード取得
     Set node = XMLDocument.SelectSingleNode("//rainfallchance")
    '属性の取得&小要素格納：rainfallchance
    i = 0
    element = node.ChildNodes.Length - 1
    ReDim memberList(element)
    ReDim memberList2(element)
    For Each childnode In node.ChildNodes
        If childnode.nodeName = "period" Then
            memberList(i) = childnode.Text
            For Each childnode2 In childnode.Attributes
                memberList2(i) = childnode2.NodeValue
            Next childnode2
        End If
    i = i + 1
    Next childnode
    
    'TextBox表示
    msg3 = "更新時間：  " & xmlDate.Text & vbCrLf & vbCrLf
    msg2 = "最高気温：  " & temp(0) & "℃" & vbCrLf & "最低気温：  " & temp(1) & "℃" & vbCrLf & vbCrLf
    msg = "降水確率" & vbCrLf & memberList2(0) & ":  " & memberList(0) & "%" & vbCrLf & memberList2(1) & ":  " & memberList(1) & "%" & vbCrLf & memberList2(2) & ":  " & memberList(2) & "%" & vbCrLf & memberList2(3) & ":  " & memberList(3) & "%"
    MsgBox msg3 & msg2 & msg, Title:="今日の天気@伊豆諸島北部"
    
ERROR_:

    '各オブジェクトの開放
    If Not XMLDocument Is Nothing Then Set XMLDocument = Nothing
    If Not xmlDate Is Nothing Then Set xmlDate = Nothing


End Sub

Public Sub sample1()

Dim XMLDocument As MSXML2.DOMDocument

Dim xmlDate As IXMLDOMNode

Dim xmlDate2 As IXMLDOMNode

Dim xmlDate3 As IXMLDOMNode

Dim time As IXMLDOMNode

Dim childnode As IXMLDOMNode

Dim childnode2 As IXMLDOMNode

Dim xmlarry() As IXMLDOMNodeList

Dim node As IXMLDOMNode

Dim memberAttribute As MSXML2.IXMLDOMAttribute

Dim memberList() As String

Dim menberList2() As String

Dim temp() As String

Dim element As Long

Dim i As Integer

Dim msg As String, msg2 As String, msg3 As String

On Error GoTo ERROR_

'MSXMLオブジェクトを生成し、xmlファイルをロード

Set XMLDocument = New MSXML2.DOMDocument

XMLDocument.async = False

XMLDocument.Load ("https://www.drk7.jp/weather/xml/13.xml")

If (XMLDocument.parseError.ErrorCode <> 0) Then 'ロード失敗

Debug.Print XMLDocument.parseError.reason 'エラー内容を出力

GoTo ERROR_

End If

'ノードの情報を取得

Set xmlDate = XMLDocument.SelectSingleNode("//weatherforecast/pubDate")

Set xmlDate2 = XMLDocument.SelectSingleNode("//temperature")

Debug.Print xmlDate.Text

Debug.Print xmlDate2.Text

element = xmlDate2.ChildNodes.Length - 1

ReDim temp(element)

i = 0

For Each xmlDate3 In xmlDate2.ChildNodes

temp(i) = xmlDate3.Text

i = i + 1

Next xmlDate3

'メンバーノード取得

Set node = XMLDocument.SelectSingleNode("//rainfallchance")

'属性の取得&小要素格納：rainfallchance

i = 0

element = node.ChildNodes.Length - 1

ReDim memberList(element)

ReDim memberList2(element)

For Each childnode In node.ChildNodes

If childnode.nodeName = "period" Then

memberList(i) = childnode.Text

For Each childnode2 In childnode.Attributes

memberList2(i) = childnode2.NodeValue

Next childnode2

End If

i = i + 1

Next childnode

'TextBox表示

msg3 = "更新時間： " & xmlDate.Text & vbCrLf & vbCrLf

msg2 = "最高気温： " & temp(0) & "℃" & vbCrLf & "最低気温： " & temp(1) & "℃" & vbCrLf & vbCrLf

msg = "降水確率" & vbCrLf & memberList2(0) & ": " & memberList(0) & "%" & vbCrLf & memberList2(1) & ": " & memberList(1) & "%" & vbCrLf & memberList2(2) & ": " & memberList(2) & "%" & vbCrLf & memberList2(3) & ": " & memberList(3) & "%"

MsgBox msg3 & msg2 & msg, Title:="今日の天気@伊豆諸島北部"

ERROR_:

'各オブジェクトの開放