Como colar títulos HTML no Excel

1

Em uma resposta anterior ( tabela vba-html para a planilha do Excel ) sobre a análise / colagem do conteúdo da tabela HTML em uma planilha do Excel, o wbeard2 compartilhou este pedaço de código muito útil e ilustrativo. Ele / ela nota que implanta os dados da tabela no Excel, mas não nos títulos. Eu queria saber como alterar esse código para incluir os títulos colunares na planilha do Excel também. Estava pensando que poderia haver uma maneira de percorrer os elementos de título semelhantes aos que são mostrados para fazer o loop de todos os arquivos e linhas dentro das linhas, mas não tenho certeza se existe um elemento de loop equivalente para os títulos - talvez ? Qualquer conselho / orientação sobre isso apreciado.

Aqui estava o código de exemplo da resposta anterior mencionada acima:

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 Reservist72 01.06.2018 / 03:18

0 respostas