【VBA】Webページの表をExcelに自動取得する方法（コピペOK）

—

コード（応用版）– MSXML2.XMLHTTPでHTML取得+パース

QueryTables.Addではうまく取得できないサイトや、テーブルの特定の列だけ取り出したい場合に使う。MSXML2.XMLHTTPでHTMLを取得し、HTMLDocumentでパースしてテーブルデータを抽出する。

QueryTables.Addで取得したらHTMLタグ付きのゴミデータだらけ。テーブル番号の指定を間違えていた。MSXML2.XMLHTTPに切り替えてからは、テーブルの行・列を正確に取得できるようになった。

'============================================================
' ■ Webテーブル取得 — MSXML2.XMLHTTP + HTMLDocument（応用版）
'   → HTTPリクエストでHTMLを取得
'   → HTMLDocumentでパースしてテーブルを抽出
'   → 参照設定不要（CreateObjectで生成）
'============================================================
Sub GetWebTableAdvanced()

    '--- ★書き換えポイント ---
    Dim targetURL As String
    targetURL = "https://example.com/data/rates.html"  '← 取得先のURL

    Dim tableIndex As Long
    tableIndex = 0                 '← 取得するテーブルのインデックス（0始まり）

    Dim sheetName As String
    sheetName = "Sheet1"           '← 書き出し先のシート名

    Dim startRow As Long
    startRow = 1                   '← 書き出し開始行

    Dim startCol As Long
    startCol = 1                   '← 書き出し開始列
    '--- ★ここまで ---

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(sheetName)

    '--- 既存データをクリア
    ws.Cells.Clear

    '--- HTTPリクエストでHTMLを取得
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")

    http.Open "GET", targetURL, False
    http.send

    '--- レスポンスチェック
    If http.Status <> 200 Then
        MsgBox "HTTPエラー: " & http.Status & " " & http.statusText & vbCrLf & _
               "URL: " & targetURL, vbExclamation
        Exit Sub
    End If

    '--- HTMLをパース
    Dim htmlDoc As Object
    Set htmlDoc = CreateObject("htmlfile")
    htmlDoc.body.innerHTML = http.responseText

    '--- テーブル要素を取得
    Dim tables As Object
    Set tables = htmlDoc.getElementsByTagName("table")

    If tables.Length = 0 Then
        MsgBox "テーブルが見つかりませんでした。" & vbCrLf & _
               "URL: " & targetURL, vbExclamation
        Exit Sub
    End If

    If tableIndex >= tables.Length Then
        MsgBox "テーブルインデックスが範囲外です。" & vbCrLf & _
               "指定: " & tableIndex & "（ページ内のテーブル数: " & tables.Length & "）", vbExclamation
        Exit Sub
    End If

    '--- 指定テーブルの行・列をExcelに書き出し
    Dim tbl As Object
    Set tbl = tables(tableIndex)

    Dim rowIdx As Long
    rowIdx = startRow

    Dim r As Long
    Dim c As Long

    For r = 0 To tbl.Rows.Length - 1
        For c = 0 To tbl.Rows(r).Cells.Length - 1
            ws.Cells(rowIdx, startCol + c).Value = tbl.Rows(r).Cells(c).innerText
        Next c
        rowIdx = rowIdx + 1
    Next r

    '--- 列幅を自動調整
    ws.Columns.AutoFit

    Set htmlDoc = Nothing
    Set http = Nothing

    MsgBox (rowIdx - startRow) & " 行を取得しました。" & vbCrLf & _
           "URL: " & targetURL, vbInformation

End Sub

書き換えポイント

コードの流れ

1. HTTPリクエスト送信: MSXML2.XMLHTTP で指定URLにGETリクエスト
2. レスポンスチェック: ステータスコード200以外ならエラー表示
3. HTMLパース: CreateObject("htmlfile") でHTMLDocumentを生成し、innerHTML にレスポンスを流し込む
4. テーブル抽出: getElementsByTagName("table") でテーブル要素を取得
5. 行・列ループ: Rows と Cells でテーブルの全セルを読み取り、Excelに書き出し
6. 列幅自動調整: AutoFitで見やすく

取得したデータを複数ブックにまとめたい場合は 複数Excelファイルを1つに統合 を参照。

—

コード（実務版）– 定期的にWebデータを取得して更新

定期取得を設定してからは、Excel開きっぱなしで1時間ごとに最新データが自動更新される。手動リロードが不要になった。

'============================================================
' ■ Webテーブル定期取得（実務版）
'   → MSXML2.XMLHTTP + HTMLDocument でテーブル取得
'   → Application.OnTime で定期的に自動更新
'   → 取得日時をヘッダーに表示
'============================================================

'--- モジュールレベル変数（定期実行の制御用）
Private nextRunTime As Date

Sub StartAutoRefresh()
    '--- 初回実行 + 定期スケジュール開始
    RefreshWebData
End Sub

Sub StopAutoRefresh()
    '--- 定期スケジュールを解除
    On Error Resume Next
    Application.OnTime nextRunTime, "RefreshWebData", Schedule:=False
    On Error GoTo 0
    MsgBox "自動更新を停止しました。", vbInformation
End Sub

Sub RefreshWebData()

    '--- ★書き換えポイント ---
    Dim targetURL As String
    targetURL = "https://example.com/data/rates.html"  '← 取得先のURL

    Dim tableIndex As Long
    tableIndex = 0                 '← 取得するテーブルのインデックス（0始まり）

    Dim sheetName As String
    sheetName = "Sheet1"           '← 書き出し先のシート名

    Dim refreshInterval As String
    refreshInterval = "01:00:00"   '← 更新間隔（時:分:秒）
    '--- ★ここまで ---

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(sheetName)

    '--- 既存データをクリア
    ws.Cells.Clear

    '--- ヘッダー行（取得日時を表示）
    ws.Cells(1, 1).Value = "最終取得: " & Format(Now, "yyyy/mm/dd hh:nn:ss")
    ws.Cells(1, 1).Font.Bold = True
    ws.Cells(1, 1).Font.Color = RGB(0, 0, 200)

    '--- HTTPリクエストでHTMLを取得
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")

    On Error GoTo ErrHandler
    http.Open "GET", targetURL, False
    http.send

    '--- レスポンスチェック
    If http.Status <> 200 Then
        ws.Cells(2, 1).Value = "HTTPエラー: " & http.Status & " " & http.statusText
        ws.Cells(2, 1).Font.Color = RGB(200, 0, 0)
        GoTo ScheduleNext
    End If

    '--- HTMLをパース
    Dim htmlDoc As Object
    Set htmlDoc = CreateObject("htmlfile")
    htmlDoc.body.innerHTML = http.responseText

    '--- テーブル要素を取得
    Dim tables As Object
    Set tables = htmlDoc.getElementsByTagName("table")

    If tables.Length = 0 Or tableIndex >= tables.Length Then
        ws.Cells(2, 1).Value = "テーブルが見つかりませんでした。"
        ws.Cells(2, 1).Font.Color = RGB(200, 0, 0)
        GoTo ScheduleNext
    End If

    '--- 指定テーブルの行・列をExcelに書き出し
    Dim tbl As Object
    Set tbl = tables(tableIndex)

    Dim rowIdx As Long
    rowIdx = 3           '← 3行目からデータ書き出し（1行目=取得日時、2行目=空行）

    Dim r As Long
    Dim c As Long

    For r = 0 To tbl.Rows.Length - 1
        For c = 0 To tbl.Rows(r).Cells.Length - 1
            ws.Cells(rowIdx, c + 1).Value = tbl.Rows(r).Cells(c).innerText
        Next c
        rowIdx = rowIdx + 1
    Next r

    '--- 1行目のヘッダーをテーブルヘッダーとして太字に
    If tbl.Rows.Length > 0 Then
        ws.Range(ws.Cells(3, 1), ws.Cells(3, tbl.Rows(0).Cells.Length)).Font.Bold = True
    End If

    '--- 列幅を自動調整
    ws.Columns.AutoFit

    ws.Cells(2, 1).Value = (rowIdx - 3) & " 行を取得しました。"

    Set htmlDoc = Nothing
    Set http = Nothing

ScheduleNext:
    '--- 次回の実行をスケジュール
    nextRunTime = Now + TimeValue(refreshInterval)
    Application.OnTime nextRunTime, "RefreshWebData"

    '--- ステータスバーに次回実行時刻を表示
    Application.StatusBar = "次回更新: " & Format(nextRunTime, "hh:nn:ss")
    Exit Sub

ErrHandler:
    ws.Cells(2, 1).Value = "エラー: " & Err.Description
    ws.Cells(2, 1).Font.Color = RGB(200, 0, 0)
    Resume ScheduleNext

End Sub

書き換えポイント

コードの流れ

1. StartAutoRefresh: 初回実行と定期スケジュールを開始するエントリポイント
2. RefreshWebData: 本体。HTTPリクエスト→HTMLパース→テーブル抽出→書き出し
3. 取得日時表示: シートの1行目に最終取得日時を書き出し
4. エラーハンドリング: HTTPエラー・テーブル未検出・通信エラーをキャッチしてシートに表示
5. 次回スケジュール: Application.OnTime で指定間隔後に自分自身を再実行
6. StopAutoRefresh: Application.OnTime ... Schedule:=False で定期実行を停止

使い方:

• StartAutoRefresh を実行 → 初回取得＋定期スケジュール開始
• StopAutoRefresh を実行 → 定期スケジュールを停止
• Excelを閉じるとスケジュールは自動的に解除される

—

よくある落とし穴5選

1. テーブル番号（インデックス）を間違えてゴミデータを取得する

自分もこれで時間を溶かした。QueryTables.Addで WebTables = "1" を指定したら、ナビゲーションバーの表が取れてしまった。ページ内には見えないテーブルも含まれているので、「ソースを表示」で

タグの順番を確認するのが確実。

対策: ブラウザの開発者ツール（F12）で

要素の数と順番を確認する。応用版なら tableIndex を変えて試行できる。

2. JavaScriptで動的生成されたテーブルが取得できない

原因: MSXML2.XMLHTTPはHTMLソースだけを取得する。JavaScriptで描画されるテーブルはHTMLソースに

が存在しないため取得できない。

対策: JavaScriptで動的生成されるテーブルは、この記事の方法では取得できない。APIが公開されている場合はAPIを利用する。

3. サイト構造の変更でコードが動かなくなる

原因: Webサイトがリニューアルするとテーブルの番号や構造が変わる。昨日まで動いていたコードが今日エラーになる。

対策: 実務版のエラーハンドリングで異常を検知する。定期的にコードの動作確認を行う。

4. 文字化けしてデータが読めない

原因: 取得先ページの文字コードとExcelの文字コードが異なる場合に発生する。

対策: http.responseText ではなく http.responseBody を ADODB.Stream で文字コード変換する方法がある。UTF-8のページが文字化けする場合はこの方法を検討する。文字コード対応の詳細は テキストファイル（txt/log）をExcelに取り込む方法 のADODB.Streamの解説も参考になる。

5. 大量アクセスでIPがブロックされる

原因: 短時間に何度もアクセスすると、サーバー側でアクセス制限がかかる。

対策: 実務版の refreshInterval を十分な間隔（30分〜1時間以上）に設定する。取得先サイトの利用規約を確認し、負荷をかけない頻度で利用する。

VBAでWebテーブルが取得できないときの対処法

「QueryTables.Addを実行したのにデータが空」という場合、原因はテーブル番号の指定ミスか、JavaScriptで動的に生成されたテーブルであることが多い。ブラウザの「ソースを表示」で

タグの数と順番を確認し、正しいテーブル番号を指定すること。

VBAでWeb取得時に文字化けするときの対処法

「HTMLを取得したら日本語が文字化けしている」という場合、原因はページの文字コード（UTF-8）とExcelの既定文字コードが異なることだ。http.responseBody を ADODB.Stream 経由で文字コード変換する方法で解決できる。

—

FAQ

Q1: 複数のテーブルを一度に取得したい

応用版のコードで、テーブルのループを追加する：

Dim t As Long
Dim rowIdx As Long
rowIdx = 1

For t = 0 To tables.Length - 1
    Set tbl = tables(t)
    For r = 0 To tbl.Rows.Length - 1
        For c = 0 To tbl.Rows(r).Cells.Length - 1
            ws.Cells(rowIdx, c + 1).Value = tbl.Rows(r).Cells(c).innerText
        Next c
        rowIdx = rowIdx + 1
    Next r
    rowIdx = rowIdx + 1   '← テーブル間に空行
Next t

Q2: 特定の列だけ取得したい

応用版のコードで、列番号を条件で絞り込む：

For r = 0 To tbl.Rows.Length - 1
    ws.Cells(rowIdx, 1).Value = tbl.Rows(r).Cells(0).innerText   '← 1列目
    ws.Cells(rowIdx, 2).Value = tbl.Rows(r).Cells(2).innerText   '← 3列目
    rowIdx = rowIdx + 1
Next r

Q3: HTTPS（SSL）のページでエラーが出る

MSXML2.XMLHTTP の代わりに MSXML2.ServerXMLHTTP を使う：

Dim http As Object
Set http = CreateObject("MSXML2.ServerXMLHTTP")
http.setOption 2, 13056   '← SSL証明書エラーを無視
http.Open "GET", targetURL, False
http.send

Q4: 取得したデータをCSVに書き出したい

取得後のシートデータを書き出す方法は、関連記事を参照。

Q5: QueryTables.AddとMSXML2.XMLHTTPのどちらを使うべき？

• QueryTables.Add（最小版）: コードがシンプル。表がそのまま取れるサイト向き。細かい制御は不要な場合
• MSXML2.XMLHTTP（応用版）: テーブルの特定列だけ取得したい、取得後に加工したい、QueryTablesで取れないサイト向き

—

まとめ

• QueryTables.Add でWebページの表をシンプルに取得できる（最小版）
• MSXML2.XMLHTTP + HTMLDocument でHTMLをパースし、任意のテーブルを正確に取得できる（応用版）
• Application.OnTime で定期的にWebデータを自動更新できる（実務版）
• Webスクレイピングはサイトの利用規約を確認し、適切な頻度で利用する

関連記事

• 複数Excelファイルを1つに統合 — 取得データを複数ブックに統合
• テキストファイル（txt／log）をExcelに取り込む方法 — ローカルファイル読み込みとの使い分け
• データをCSVファイルに書き出す方法 — 取得データをCSVに書き出して保存
• 指定時刻にマクロを自動実行する方法 — OnTimeによる定期取得の基本
• エラー処理で止まらないマクロを作る方法 — HTTP通信エラーへの対処法

—

次にやりたくなること

• 複数Excelファイルを1つに統合: 複数サイトから取得したデータを1つのブックにまとめる
• テキストファイル（txt/log）をExcelに取り込む方法: Webではなくローカルのテキストファイルを自動で読み込みたい場合
• データをCSVファイルに書き出す方法: 取得したWebデータをCSVに書き出して他システムに連携したい場合
• 指定時刻にマクロを自動実行する方法: 定期取得をOnTimeで自動化したい場合
• エラー処理で止まらないマクロを作る方法: HTTP通信エラーで止まらない堅牢なマクロにしたい場合

—

もっとカスタマイズしたい場合

「特定のサイトだけ取得したい」「ログイン後のページを取得したい」「取得データを自動で集計・グラフ化したい」など、業務に合わせたカスタマイズが必要な場合は、ココナラで相談できる。

相談時に伝えると話が早い情報:

• Excel のバージョン / OS
• 取得先のURL（可能であれば）
• 取得したいテーブルの位置・列
• 更新頻度の目安
• 取得後の加工内容（集計・グラフなど）

スポンサーリンク

【VBA】ピボットテーブルをVBAで自動生成する方法（コピペOK）

【VBA】ExcelからOutlookの予定表に一括登録する方法（コピペOK）

コメント

• メニュー
  • ファイル操作
  • シート操作
  • 外部連携
  • 運営者情報
  • お問い合わせ
  • プライバシーポリシー
• ホーム
• 検索
• トップ
• サイドバー

タイトルとURLをコピーしました