VBAのHTTP通信でWebスクレイピング

excelvba

「ツール」メニューの「参照設定」のところで
Microsoft HTML Object Library
Microsoft XML, v6.0
を追加して使ってね

重い環境だとhtmlDoc.writeの後、読み込み終わってなくてエラーになることがあるみたい。リトライ処理するといい感じ。

Sub HTTP通信()
    Dim httpReq As XMLHTTP60
    Set httpReq = New XMLHTTP60
    
    httpReq.Open " GET", "https://www.eb.pref.okinawa.jp/kassui/"
    httpReq.send 'HTTPリクエスト送信
    
    Do While httpReq.readyState < 4 '処理待ち
        DoEvents
    Loop
    
    Dim htmlDoc As Object
    Set htmlDoc = New HTMLDocument
    htmlDoc.write httpReq.responseText
    
    '読み込み途中だと例外でるからRETRYに飛ばして再挑戦させる
    Dim dblTimer: dblTimer = Timer
    On Error GoTo LABEL_RETRY
LABEL_RETRY:
    DoEvents
    If 60 < Timer - dblTimer Then '60sでタイムアウト
        Exit Sub
    End If

    Dim hiduke As IHTMLElement
    Set hiduke = htmlDoc.getElementById("chosui_hiduke")
    Debug.Print "■日付は「" & hiduke.innerHTML & "」です。"

    Dim chosuiritsu As IHTMLElement
    Set chosuiritsu = htmlDoc.getElementById("ritsu_today4")
    Debug.Print "■本日の貯水率は「" & chosuiritsu.innerHTML & "」です。"

    Set httpReq = Nothing
    Set htmlDoc = Nothing
End Sub

ネタ元