VBAオジサンのらくがき帳

ウェブからデータを取得する

2021-08-08 00:00:00

ウェブからデータを取得する方法を2種類、MSXML2.ServerXMLHTTP オブジェクトを使う方法と、Windows APIのURLDownloadToFileA関数を使う方法を紹介します。サンプルでは「統計で見る日本（https://www.e-stat.go.jp/）」のサービスを利用しました。使うには利用者登録（appIdの取得）が必要です。

下のコードを実行すると、URLで指定したデータが取得されイミディエイトウィンドウに出力されます。

Dim req As Object 'MSXML2.ServerXMLHTTP60
Dim url As String
url = "http://api.e-stat.go.jp/rest/3.0/app/getSimpleStatsData?" & _
        "appId=********" & _
        "&lang=J" & _
        "&statsDataId=0003425734" & _
        "&metaGetFlg=Y" & _
        "&cntGetFlg=N" & _
        "&explanationGetFlg=Y" & _
        "&annotationGetFlg=Y" & _
        "&sectionHeaderFlg=2" & _
        "&replaceSpChars=0"
    
Set req = CreateObject("MSXML2.ServerXMLHTTP")
req.Open "GET", url, False
req.send
Debug.Print req.responseText
Set req = Nothing

req.Openの3番目の引数をTrueにした場合は、非同期処理となり下のようにステータスを確認して処理を行います。タイムアウト処理などを行いたい場合はこちらを使うといいと思います。

req.Open "GET", url, True
req.send

If req.readyState <> 4 Then
    req.waitForResponse 10
End If

If req.readyState = 4 Then
    Debug.Print req.responseText
End If

URLDownloadToFileA関数 は下のように宣言します。指定したURLのデータをファイルに保存します。

Public Declare PtrSafe Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, _
        ByVal szURL As String, _ByVal szFileName As String, ByVal dwReserved As Long, _
        ByVal lpfnCB As Long) As Long

下のサンプルコードでデータの取得ができます。

Dim url As String
Dim filePath As String
Dim ret As Long
url = "http://api.e-stat.go.jp/..."
filePath = "C:\workarea\test.csv"

ret = URLDownloadToFileA(0, url, filePath, 0, 0)
If ret <> 0 Then
    ConvUtf8WithBom filePath '※文字化け回避のため

    Workbooks.Open filePath
End If

※サンプルではダウンロードデータがBOMなしのUTF-8で保存されるため、そのままだとExcelでは文字化けするので、下のサブプロシージャを作って対応しました。

Sub ConvUtf8WithBom(filePath As String)
    Dim st As Object ' ADODB.Stream
    Dim dat As String

    Set st = CreateObject("ADODB.Stream")
    st.Charset = "UTF-8"
    st.Open
    st.LoadFromFile filePath
    dat = st.ReadText
    st.Close
    st.Open
    st.WriteText dat, 0
    st.SaveToFile filePath, 2
    st.Close
End Sub