☰

vba - HTML テーブルを Excel ワークシートに変換

tag-icon • tag-icon microsoft-excel vba macros
vba - HTML テーブルを Excel ワークシートに変換

ローカルの HTML テーブル データを Excel ワークシートに抽出できる VBA スクリプトが必要です。URL リンクを使用して動作するコード (Web 上のどこかで見つけたもの) がありますが、ローカルに保存されている HTML ファイルを使用して実行できるようにしたいのです。エラーは次のとおりです。app defined or object defined error

Sub HTML_Table_To_Excel()

Dim htm As Object
Dim Tr As Object
Dim Td As Object
Dim Tab1 As Object


'Replace the URL of the webpage that you want to download
Web_URL = "http://espn.go.com/nba/"

'Create HTMLFile Object
Set HTML_Content = CreateObject("htmlfile")

'Get the WebPage Content to HTMLFile Object
With CreateObject("msxml2.xmlhttp")
.Open "GET", Web_URL, False
.send
HTML_Content.body.innerHTML = .responseText 'this is the highlighted part for the error
End With

Column_Num_To_Start = 1
iRow = 2
iCol = Column_Num_To_Start
iTable = 0

'Loop Through Each Table and Download it to Excel in Proper Format
For Each Tab1 In HTML_Content.getElementsByTagName("table")
With HTML_Content.getElementsByTagName("table")(iTable)
For Each Tr In .Rows
For Each Td In Tr.Cells
Sheets(1).Cells(iRow, iCol).Select
Sheets(1).Cells(iRow, iCol) = Td.innerText
iCol = iCol + 1
Next Td
iCol = Column_Num_To_Start
iRow = iRow + 1
Next Tr
End With

iTable = iTable + 1
iCol = Column_Num_To_Start
iRow = iRow + 1
Next Tab1

MsgBox "Process Completed"
End Sub

答え1

今週初めにこのコードを書きました。最初のテーブルを検索し、ヘッダーを除いた HTML テーブルのすべてのデータを A1 から始まるアクティブ シートにコピーします。

HTML アドレスを、最初の引用符の間の ie.navigate 行の下に入力します。

Private Sub Test()

   Dim ie As Object, i As Long, strText As String

   Dim doc As Object, hTable As Object, hBody As Object, hTR As Object, hTD As Object
   Dim tb As Object, bb As Object, tr As Object, td As Object

   Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

     Set wb = Excel.ActiveWorkbook
     Set ws = wb.ActiveSheet

     Set ie = CreateObject("InternetExplorer.Application")
     ie.Visible = True

      y = 1   'Column A in Excel
      z = 1   'Row 1 in Excel

     ie.navigate "http://", , , , "Content-Type: application/x-www-form-urlencoded" & vbCrLf

     Do While ie.busy: DoEvents: Loop
     Do While ie.ReadyState <> 4: DoEvents: Loop

     Set doc = ie.document
     Set hTable = doc.GetElementsByTagName("table")


     For Each tb In hTable

        Set hBody = tb.GetElementsByTagName("tbody")
        For Each bb In hBody

            Set hTR = bb.GetElementsByTagName("tr")
            For Each tr In hTR


                 Set hTD = tr.GetElementsByTagName("td")
                 y = 1 ' Resets back to column A
                 For Each td In hTD
                   ws.Cells(z, y).Value = td.innertext
                   y = y + 1
                 Next td
                 DoEvents
                 z = z + 1
            Next tr
            Exit For
        Next bb
    Exit For
  Next tb

End Sub

関連情報