【Excel VBA×Selenium】WebページのテーブルをExcelへ一覧取得する方法｜table・tr・tdを繰り返し取得

<!-- 表全体を表すtableタグ -->
<table id="table1">

    <!-- 見出し部分 -->
    <thead>
        <tr>
            <!-- 各列の見出しをthタグで定義 -->
            <th>氏名</th>
            <th>部署</th>
            <th>メールアドレス</th>
        </tr>
    </thead>

    <!-- 実際のデータ部分 -->
    <tbody>
        <tr>
            <!-- 1行分のデータをtdタグで定義 -->
            <td>山田 太郎</td>
            <td>営業部</td>
            <td>yamada@example.com</td>
        </tr>
    </tbody>

</table>

'取得対象となるtable要素を格納する変数
Dim tableElement As Selenium.WebElement

'id="table1"のtable要素を取得する
Set tableElement = driver.FindElementById("table1")

'table内の複数のtr要素を格納する変数
Dim rows As Selenium.WebElements

'現在処理している1行分のtr要素を格納する変数
Dim rowElement As Selenium.WebElement

'table内に存在するtr要素をすべて取得する
Set rows = tableElement.FindElementsByTag("tr")

'取得したtr要素を1行ずつ繰り返し処理する
For Each rowElement In rows

    '確認用として、現在の行に含まれる文字列をイミディエイトウィンドウへ出力する
    Debug.Print rowElement.Text

Next rowElement

'1行の中に存在する複数のtd要素を格納する変数
Dim cells As Selenium.WebElements

'現在処理している1セル分のtd要素を格納する変数
Dim cellElement As Selenium.WebElement

'取得済みの行を1行ずつ処理する
For Each rowElement In rows

    '現在の行に含まれるtd要素をすべて取得する
    Set cells = rowElement.FindElementsByTag("td")

    '取得したtd要素を1セルずつ処理する
    For Each cellElement In cells

        '確認用としてセルの文字列をイミディエイトウィンドウへ出力する
        Debug.Print cellElement.Text

    Next cellElement

Next rowElement

'Excelへ出力する行番号
Dim outputRow As Long

'Excelへ出力する列番号
Dim outputCol As Long

'1行目は見出しとして使用するため、データは2行目から出力する
outputRow = 2

'Webテーブルの行を1行ずつ処理する
For Each rowElement In rows

    '現在の行に含まれるtd要素をすべて取得する
    Set cells = rowElement.FindElementsByTag("td")

    'tdが存在する行だけExcelへ出力する
    If cells.Count > 0 Then

        '新しい行を処理するたびに、出力列をA列へ戻す
        outputCol = 1

        '現在の行に含まれるセルを左から順番に処理する
        For Each cellElement In cells

            '取得した文字列をExcelの対応するセルへ出力する
            Worksheets("Sheet1").Cells(outputRow, outputCol).Value = _
                cellElement.Text

            '次のExcel列へ移動する
            outputCol = outputCol + 1

        Next cellElement

        '1行分の出力が終わったら、Excelの次の行へ移動する
        outputRow = outputRow + 1

    End If

Next rowElement

'見出しとなる複数のth要素を格納する変数
Dim headers As Selenium.WebElements

'現在処理している1つのth要素を格納する変数
Dim headerElement As Selenium.WebElement

'Excelへ出力する列番号
Dim colNum As Long

'table内に存在するth要素をすべて取得する
Set headers = tableElement.FindElementsByTag("th")

'見出しはExcelのA列から出力する
colNum = 1

'取得した見出しを左から順番に処理する
For Each headerElement In headers

    'Webテーブルの見出しをExcelの1行目へ出力する
    Worksheets("Sheet1").Cells(1, colNum).Value = headerElement.Text

    '次の列へ移動する
    colNum = colNum + 1

Next headerElement

Sub GetWebTable()

    '==================================================
    ' 変数を定義する
    '==================================================
    'SeleniumでChromeを操作するためのWebDriver
    Dim driver As New Selenium.WebDriver

    '取得対象のtable要素
    Dim tableElement As Selenium.WebElement

    'table内の複数行を格納する
    Dim rows As Selenium.WebElements

    '1行内の複数セルを格納する
    Dim cells As Selenium.WebElements

    'table内の見出しを格納する
    Dim headers As Selenium.WebElements

    '現在処理している1行分の要素
    Dim rowElement As Selenium.WebElement

    '現在処理している1セル分の要素
    Dim cellElement As Selenium.WebElement

    '現在処理している1つの見出し要素
    Dim headerElement As Selenium.WebElement

    '取得結果を出力するExcelシート
    Dim ws As Worksheet

    'Excelへ出力する行番号
    Dim outputRow As Long

    'Excelへ出力する列番号
    Dim outputCol As Long

    '==================================================
    ' 出力先となるExcelシートを準備する
    '==================================================
    '取得結果の出力先をSheet1に設定する
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    '前回取得したデータが残らないように、既存データを削除する
    ws.Cells.ClearContents

    '==================================================
    ' Chromeを起動して対象ページを開く
    '==================================================
    'Chromeを起動する
    driver.Start "Chrome"

    'テーブル取得用のサンプルページを開く
    driver.Get "https://the-internet.herokuapp.com/tables"

    'ページが表示されるまで1秒待機する
    driver.Wait 1000

    '==================================================
    ' 対象となるtable要素を取得する
    '==================================================
    'id="table1"のtable要素を取得する
    Set tableElement = driver.FindElementById("table1")


    '==================================================
    ' Webテーブルの見出しをExcelへ出力する
    '==================================================

    'table内に存在するth要素をすべて取得する
    Set headers = tableElement.FindElementsByTag("th")

    '見出しはExcelのA列から出力する
    outputCol = 1

    '取得した見出しを左から順番に処理する
    For Each headerElement In headers

        '見出し文字列をExcelの1行目へ出力する
        ws.Cells(1, outputCol).Value = headerElement.Text

        '次の列へ移動する
        outputCol = outputCol + 1

    Next headerElement


    '==================================================
    ' Webテーブルのデータ行を取得する
    '==================================================

    'table内に存在するtr要素をすべて取得する
    Set rows = tableElement.FindElementsByTag("tr")

    'データは見出しの次となるExcelの2行目から出力する
    outputRow = 2


    '==================================================
    ' 行ループ × 列ループでExcelへ転記する
    '==================================================

    'Webテーブルの行を1行ずつ処理する
    For Each rowElement In rows

        '現在の行に含まれるtd要素をすべて取得する
        Set cells = rowElement.FindElementsByTag("td")

        'tdが存在する行だけ出力する
        '見出し行はthで構成されているため、この条件で除外される
        If cells.Count > 0 Then

            '新しい行を処理するたびに、出力列をA列へ戻す
            outputCol = 1

            '現在の行に含まれるセルを左から順番に処理する
            For Each cellElement In cells

                'Webページから取得した文字列をExcelへ出力する
                ws.Cells(outputRow, outputCol).Value = cellElement.Text

                '次のExcel列へ移動する
                outputCol = outputCol + 1

            Next cellElement

            '1行分の出力が終わったら、Excelの次の行へ移動する
            outputRow = outputRow + 1

        End If

    Next rowElement


    '==================================================
    ' 処理完了を通知する
    '==================================================

    MsgBox "テーブルの取得が完了しました。", vbInformation

End Sub

'取得したセルが空文字か確認する
If Trim(cellElement.Text) = "" Then

    '空セルの場合は「-」をExcelへ出力する
    ws.Cells(outputRow, outputCol).Value = "-"

Else

    '値が存在する場合は取得した文字列をそのまま出力する
    ws.Cells(outputRow, outputCol).Value = cellElement.Text

End If