VBA复制html表格数据到excel工作表答案

【问题标题】：VBA copy html table data to excel worksheetVBA复制html表格数据到excel工作表
【发布时间】：2020-09-04 00:29:01
【问题描述】：

我需要一个可以将本地 html 表格数据提取到 Excel 工作表的 VBA 脚本。我有一些使用 URL 链接工作的代码（在网络上的某个地方找到），但我想要的是能够使用我本地存储的 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

【问题讨论】：

您尝试将file:// 换成WEB_URL 吗？例如，如果您的文件存储在 ~/User/abc.html 中，您可以尝试：WEB_URL = "file:///Users/abc.html"
是的。我试过WEB_URL = "file://C:/users/folder/test.html"。那没起效。得到同样的错误。
试试这个：stackoverflow.com/a/9759937/1505987
要使用正确的 URL 制作 XHR，连接前缀 file:/// 和文件的编码路径（使用 EncodeUriComponent() 函数，如 in this answer）。

标签： excel vba

【解决方案1】：

我遇到了同样的问题，为了解决这个问题，我使用了问题的原始代码，但我没有下载 html，而是将 html 作为文本文件打开，并将结果传递给对象 HTML_Content.body.innerHtml其余代码相同。

Sub HTML_Table_To_Excel() 

Dim htm As Object 
Dim Tr As Object 
Dim Td As Object 
Dim Tab1 As Object
Dim file as String

'Replace the file path with your own 
file = "c:\your_File.html"

'Determine the next file number available for use by the FileOpen function
TextFile = FreeFile

'Open the text file
Open file For Input As TextFile

'Create HTMLFile Object 
Set HTML_Content = CreateObject("htmlfile") 
HTML_Content.body.innerHtml = Input(LOF(TextFile), TextFile)

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

【讨论】：

【解决方案2】：

不确定我是否遵循了约定，但我设法成功地将 HTML 表导出到 excel。这是我的VB脚本。欢迎任何优化/更正！谢谢。

Sub Export()
rowsLength =document.all.yourHTMLTableId.rows.length
cellLength= (document.all.yourHTMLTableId.Cells.length/rowsLength) 'Because i dont know how to get no.of cells in a row,so used a simple division 

 Set crr = CreateObject("WScript.Shell")

 fileNm= "Export"
 dir= crr.CurrentDirectory&"\"&fileNm&".xlsx"
 Set objExcel = CreateObject("Excel.Application")
 Set objWorkbook = objExcel.Workbooks.Add()
 Set objWorksheet= objWorkbook.Worksheets(1)
 i=0
 j=0

 do until i=rowsLength
   do until j=cellLength
   objWorksheet.cells(i+1,j+1).value =  document.all.yourHTMLTableId.rows(i).cells(j).innerHTML
   msgbox document.all.yourHTMLTableId.rows(i).cells(j).innerHTML 
   j= j+1
   Loop
 j=0    
 i=i+1
 Loop
 objWorkbook.SaveAs(dir)
 objWorkbook.close
 objExcel.Quit
 Set objExcel = Nothing

结束子

【讨论】：