Sub SaveHTMLTableToLocalTable(ByVal strURL As String)
Dim objHTTP As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim iRow As Integer
Dim iCol As Integer
Dim nNum As Long, i As Long, j As Long
Dim var As Variant, content As String
' Create a new instance of the XMLHTTP object
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
' Open the URL
objHTTP.Open "GET", strURL, False
' Send the request
objHTTP.send
' Get the response text (HTML content)
Dim htmlContent As String
htmlContent = objHTTP.responseText
' Close the connection
objHTTP.abort
' Release the object
Set objHTTP = Nothing
i = InStr(1, htmlContent, "<tr>")
htmlContent = Trim$(Mid$(htmlContent, i))
i = InStrRev(htmlContent, "</tr>")
htmlContent = Trim$(Left$(htmlContent, i - 1))
var = Split(htmlContent, "<tr>")
' Open the database
Set db = CurrentDb
nNum = Val(DMax("Reference", "responseT") & "") + 1
' Open the table to which you want to save the HTML table data
Set rs = db.OpenRecordset("responseT", dbOpenDynaset)
For j = 0 To UBound(var)
content = var(j)
content = Replace$(Replace$(Replace$(content, "<td>", ""), "</td>", ""), "</tr>", "")
content = Trim$(Replace$(content, Chr(9), ""))
If Len(content) Then
i = InStr(1, content, "?email=")
If i <> 0 Then
content = Mid$(content, i + Len("?email="))
content = Left$(content, InStrRev(content, """>") - 1)
Else
If InStr(1, content, "<br />") <> 0 Then
content = PlainText(content)
End If
End If
rs.AddNew
rs.Fields("Reference") = nNum
rs.Fields("Message").Value = content
rs.Update
End If
Next j
' Close the recordset
rs.Close
' Release the objects
Set rs = Nothing
Set db = Nothing
Rem MsgBox "HTML table saved to local table successfully."
End Sub