Hello jhowland,
Paste these three macros into a new VBA Module. The macro TestA will copy the tables from the file name you specify in the TestA to the "Sheet3" starting at cell A1.
The macro CopyTables sets the starting cell for the table output.
Public htmlDoc As Object
Public PageSrc As String
Function OpenHTMLFile(ByVal Filename As String) As Long
' If File is opened successfully, the return value is zero. Otherwise, the error number is returned.
Dim ByteData() As Byte
PageSrc = ""
On Error GoTo ErrorHandler
' Retrieve the HTML text for the PageSource from a local file.
Open Filename For Binary As #1
ReDim ByteData(LOF(1))
Get #1, , ByteData
Close #1
PageSrc = StrConv(ByteData, vbUnicode)
If PageSrc = "" Then
MsgBox "The File has No Data.", vbOKOnly + vbExclamation
Exit Function
End If
' Create an empty HTML Document and load it with the PageSource.
Set htmlDoc = CreateObject("htmlfile")
htmlDoc.Open URL:="text/html", Replace:=False
' NOTE: This will check if cookies are enabled and prompt you if they aren't.
htmlDoc.write PageSrc
ErrorHandler:
If Err <> 0 Then
OpenHTMLFile = Err.Number
End If
End Function
Sub CopyTables(ByVal WksName As String)
Dim c As Long
Dim n As Long
Dim oTable As Object
Dim oTables As Object
Dim OutputCell As Range
Dim r As Long
Dim Wks As Worksheet
Set Wks = Worksheets(WksName)
Set OutputCell = Wks.Range("A1")
Set oTables = htmlDoc.getElementsByTagName("table")
For Each oTable In oTables
For r = 0 To oTable.Rows.Length - 1
For c = 0 To oTable.Rows(r).Cells.Length - 1
OutputCell.Offset(n, c + 1).Value = oTable.Rows(r).Cells(c).innerText
Next c
n = n + 1
Next r
' Add a blank row between tables.
n = n + 1
Next oTable
End Sub
Sub TestA()
Dim Filename As String
Dim n As Long
Filename = "C:\Users\Owner\Documents\Excel Forum\jhowland\daily_rates.htm"
n = OpenHTMLFile(Filename)
If n = 0 Then
Call CopyTables("Sheet3")
Else
Err.Raise n
End If
End Sub
Bookmarks