XXXXXさんへ VBA IE操作 1ページに複数のテーブルがある場合

下記の質問をいただきました。

>【質問】
>ＴＡＢＬＥが一つならＯＫなのですが、複数あると手も足も出ません。
>複数あるときの処理を教えていただけないでしょうか。
>全てのＴＡＢＬＥデータを取り出したのですが・・・
>【現状コード】
>Set objTable = objIE.document.getElementsByTagName("table")(0)
>For i = 0 To objTable.Rows.Length - 1
>
> For j = 0 To objTable.Rows(i).Cells.Length - 1
>
> objTable.Rows(i).Cells(j).innerText
> aa = objTable.Rows(i).Cells(j).innerText
> Sheets("情報").Cells(i + 1, j + 1) = aa
> Next j
>
>Next i

テーブルの指定が
Set objTable = objIE.document.getElementsByTagName("table")(0)

.getElementsByTagName("table")(0)
と、
(0)で0番目の指定、
頭を固定で取っているので、
これを全てのテーブルで回すように変更すれば、、、

.getElementsByTagName("table")(0)
を
.getElementsByTagName("table")
にしてループで使います。

テーブルの数が、
.Length
でわかるので、
外側にテーブル単位のループを追加する、
そんな処置をしてみます。

Set objTABLEs = objIE.document.getElementsByTagName("table")
で
テーブルを集めて、
For n = 0 To objTABLEs.Length - 1
のループを作り、
objTABLEs(テーブル).Rows(行).Cells(列).innerText
みたいに使った話

操作・解説動画
www.youtube.com
https://www.youtube.com/watch?v=TqHB16Mj8tI
↑失敗操作、デバッグ風景を笑ってくださいね。ぉぃぉぃ。

#VBA #IE操作 #TABLE
#デバッグ風景
#getElementsByTagName
#Length

テストで使用したソースファイル

http://ie.vba-ken3.jp/test/20161101j1j2.html
↑テストの表ここから下記のコードでデータを抜く・・・

Option Explicit

Sub le_test20161206_複数テーブルを取得()

    'IE起動
    Dim objIE    As Object  'ＩＥオブジェクト参照用
    Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
    objIE.Visible = True '見えるようにする(お約束)
    
    '.Navigate で 指定した文字列のURLを開く
    objIE.Navigate "http://ie.vba-ken3.jp/test/20161101j1j2.html"

    '表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が４以外の時 ループ
    Do While objIE.Busy = True
         DoEvents  '特に何もしないで.Busyの状態が変わるまで待つ
    Loop
    Do While objIE.ReadyState <> 4
         DoEvents  '特に何もしないで.ReadyStateの状態が４に変わるまで待つ
    Loop
    
    'テーブルを探す
    'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
    Dim objTABLEs As Object 'TABLEを複数 格納用
    
    'TABLEタグを複数取り出す
    Set objTABLEs = objIE.document.getElementsByTagName("table")

    'まず、書き込み先シートに切り替え、データをクリアする
    Sheets("DATA").Select    'シートを切り替える
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A1").Select       '先頭A1を選択する、
    
    '表をDATAシートに書き出す
    Dim j As Integer  '列の管理
    Dim i As Integer  '行の管理
    Dim n As Integer  'TABLEの管理
    Dim yy As Integer 'セットする行
    Dim aa As String  '一時保管用
    
  
  'Webの表をシートへ転記(代入する)
  yy = 1  'セットする位置を初期化
  
  For n = 0 To objTABLEs.Length - 1  'TABLEの数ループ
    
    For i = 0 To objTABLEs(n).Rows.Length - 1 '行の数 ループ
    
       For j = 0 To objTABLEs(n).Rows(i).Cells.Length - 1  '列のループ
            'objTABLEs(テーブル).Rows(行).Cells(列).テキスト値
            aa = objTABLEs(n).Rows(i).Cells(j).innerText
            Sheets("DATA").Cells(yy, j + 1) = aa
       Next j
       
       yy = yy + 1   'セット位置 行を増やす
    
    Next i
    
  Next n
  
    '終了処理
    objIE.Quit  'IEを閉じる
    Set objIE = Nothing   '変数の後始末
    
End Sub

おまけ・蛇足 TRで集めて処理してみた

Sub le_test20161206_TRタグを集めてみた()

    'IE起動
    Dim objIE    As Object  'ＩＥオブジェクト参照用
    Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
    objIE.Visible = True '見えるようにする(お約束)
    
    '.Navigate で 指定した文字列のURLを開く
    objIE.Navigate "http://ie.vba-ken3.jp/test/20161101j1j2.html"

    '表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が４以外の時 ループ
    Do While objIE.Busy = True
         DoEvents  '特に何もしないで.Busyの状態が変わるまで待つ
    Loop
    Do While objIE.ReadyState <> 4
         DoEvents  '特に何もしないで.ReadyStateの状態が４に変わるまで待つ
    Loop
    
    'TR 行を探す
    'タグの取出しが、.getElementsByTagName("TR")で 可能なので、
    Dim objTR As Object 'TR タグを複数 格納用
    
    'TRタグを複数取り出す
    Set objTR = objIE.document.getElementsByTagName("TR")

    'まず、書き込み先シートに切り替え、データをクリアする
    Sheets("DATA").Select    'シートを切り替える
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A1").Select       '先頭A1を選択する、
    
    '表をDATAシートに書き出す
    Dim j As Integer  '列の管理
    Dim i As Integer  '行の管理
    Dim yy As Integer 'セットする行
    Dim aa As String  '一時保管用
    
  
  'Webの表をシートへ転記(代入する)
  yy = 1  'セットする位置を初期化
  
    For i = 0 To objTR.Length - 1 '行の数 ループ
    
       For j = 0 To objTR(i).Cells.Length - 1  '列のループ
            'objTR(行).Cells(列).テキスト値
            aa = objTR(i).Cells(j).innerText
            Sheets("DATA").Cells(yy, j + 1) = aa
       Next j
       
       yy = yy + 1   'セット位置 行を増やす
    
    Next i
    
    '終了処理
    objIE.Quit  'IEを閉じる
    Set objIE = Nothing   '変数の後始末
    
End Sub