vba - tabela html para excel planilha

1

Eu preciso de um script vba que possa extrair dados da tabela html local para a planilha do excel. Eu tenho um código (encontrado em algum lugar na web) que funciona usando link de URL, mas o que eu quero é poder fazê-lo usando o meu arquivo html armazenado localmente. O erro é 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
    
por deshawn99 05.12.2015 / 02:22

1 resposta

1

Eu escrevi este código no início desta semana. Ele pesquisará a primeira tabela e copiará todos os dados da tabela HTML menos os cabeçalhos para a planilha ativa, começando em A1.

Coloque o seu endereço HTML sob a linha ie.navigate entre as primeiras aspas.

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
    
por 05.12.2015 / 03:57