WEB HTML形式のテーブル(表)の値を取得する

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][WEB HTML形式のテーブル(表)の値を取得する]
Option Explicit
'**************************************************
'HTML形式のテーブル(表)の値を取得する
'**************************************************
'1.ユーザーフォームを設置 UserForm1
'2.テキストボックスを設置 TextBox1
'3.コマンドボタンを設置 CommandButton1
'4.WebBrowserを設置 WebBrowser1


'**************************************************
'フォーム上のブラウザに指定アドレス先を表示
'**************************************************
Private Sub CommandButton1_Click()
    Me.WebBrowser1.Navigate Trim(Me.TextBox1.Value)
End Sub



'**************************************************
'読み込み(DL)が完了後発生するイベント
'**************************************************
'注意:テーブルエレメントは行も列も「0」から始まります。
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

Dim sht As Worksheet, cnt As Long
Dim cnty As Long, str As String

'抽出した値を格納するシートを指定
Set sht = ThisWorkbook.Worksheets("Sheet4")

Dim objTable As Object
Dim 全テーブル数 As Long
Dim 該当テーブル番号 As Long
Dim 行数 As Long, x As Long
Dim 列数 As Long, y As Long
Dim テキスト As String
Dim 目的タイトル As String

    'HTMLドキュメントのテーブルタグをオブジェクトにセット
    Set objTable = Me.WebBrowser1.Document.getElementsByTagName("TABLE")

    'TABLEが無い場合
    If objTable Is Nothing Then
        Set objTable = Nothing
        MsgBox "TABLE Object Nothing!"
        Exit Sub
    End If

    'TABLEが無い場合
    If objTable.Length = 0 Then
        Set objTable = Nothing
        MsgBox "TABLE Object 全テーブル数 = 0!"
        Exit Sub
    Else
        全テーブル数 = objTable.Length - 1
    End If

    '全テキストのみ抽出(因みに)
    テキスト = objTable(0).Rows(0).Cells(0).innerText

    '目的のテーブル番号指定
    該当テーブル番号 = 7

    str = objTable(該当テーブル番号).Rows(0).Cells(0).innerText

    目的タイトル = Trim(Mid(str, 1, InStr(1, str, "[") - 1))

    '目的のテーブル番号指定
    該当テーブル番号 = 11

    '目的のテーブル行数取得
    行数 = objTable(該当テーブル番号).Rows.Length - 1 '縦数

    'エラー回避
    If 行数 < 0 Then
        MsgBox "TABLE Object ERR!"
        Exit Sub
    End If

        '(項目行必要の場合は0から始める)
        '(項目行不要の場合は1から始める)
        For x = 1 To 行数
            '目的のテーブル列数取得
            列数 = objTable(該当テーブル番号).Rows(x).Cells.Length - 1
                'エラー回避
                If 列数 < 0 Then
                    MsgBox "TABLE Object ERR!"
                    Exit Sub
                End If

            '書き込むシートの最終行取得
            cnt = sht.Cells(65536, 1).End(xlUp).Row + 1
            'シート書き込み用列番号を初期化
            cnty = 0
            cnty = cnty + 1
            sht.Cells(cnt, cnty).Value = 目的タイトル
            For y = 0 To 列数
                cnty = cnty + 1
                テキスト = objTable(該当テーブル番号).Rows(x).Cells(y).innerText
                Debug.Print "テ[" & 該当テーブル番号 & "]" & "行[" & x & "]" & "列[" & y & "]:" & テキスト
                sht.Cells(cnt, cnty).Value = Trim(テキスト)
            Next y
        Next x

    Set objTable = Nothing

End Sub





Production Japan Import Application. Since 1998