vba - tabla html para hoja de cálculo de excel

vba - tabla html para hoja de cálculo de excel

Necesito un script vba que pueda extraer datos de la tabla html local a una hoja de cálculo de Excel. Tengo un código (lo encontré en algún lugar de la web) que funciona mediante un enlace URL, pero lo que quiero es poder hacerlo utilizando mi archivo html almacenado localmente. El error esapp 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

Respuesta1

Escribí este código a principios de esta semana. Buscará la primera tabla y copiará todos los datos de la tabla HTML menos los encabezados a la hoja activa comenzando en A1.

Coloque su dirección HTML debajo de la línea ie.navigate entre las primeras comillas.

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

información relacionada