Access web page and insert data to a user defined array

Option Explicit

'need reference to:
' - Microsoft CDO for Windows...
' - Microsoft ActiveX Data Object ver. no.

'function to save web pages on the local computer
Private Function SaveWebPage(ByVal sUrl As String, ByVal sFilePath As String) As Boolean
Dim iMessage As CDO.Message
Dim adodbstream As ADODB.Stream
Dim bBool As Boolean

On Error GoTo Err_SaveWebPage

bBool = True 'default returning value
Set iMessage = New CDO.Message
Set adodbstream = New ADODB.Stream

iMessage.CreateMHTMLBody sUrl, CDO.CdoMHTMLFlags.cdoSuppressNone, "", ""
adodbstream.Type = ADODB.StreamTypeEnum.adTypeText
adodbstream.Charset = "US-ASCII"
adodbstream.Open
iMessage.DataSource.SaveToObject adodbstream, "_Stream"
adodbstream.SaveToFile sFilePath, ADODB.SaveOptionsEnum.adSaveCreateOverWrite


Exit_SaveWebPage:
    On Error Resume Next
    Set iMessage = Nothing
    Set adodbstream = Nothing
    SaveWebPage = bBool
    Exit Function

Err_SaveWebPage:
    bBool = False
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SaveWebPage
    
End Function

Private Sub CommandButton1_Click()
Dim bRetVal As Boolean
Dim sUrl As String, sDstFile As String, sTmp As String
Dim sLookFor As Variant, i As Integer, j As Integer

sLookFor = Array("<table>", "</table>", "<tr>", "</tr>", "<th>", "</th>", "<td>", "</td>") 'find this parts
sUrl = Me.TxtUrl.Text 'http://losmac.republika.pl/download.html
sDstFile = Me.TxtDstFile.Text 'D:\tmp.html
bRetVal = SaveWebPage(sUrl, sDstFile)
If Not bRetVal Then Exit Sub 'can't save web page - exit Sub
Open sDstFile For Input Lock Read As #1 'open web page to read it content
    Do While Not EOF(1) '
        Line Input #1, sTmp 'get single line
        For i = LBound(sLookFor) To UBound(sLookFor) 'look for...
            j = InStr(1, sTmp, sLookFor(i)) 'get the position
            If j > 0 Then
                MsgBox "'" & sLookFor(i) & "' found in the string: " & vbCrLf & _
                        "'" & sTmp & "'" & vbCrLf & _
                        "on the position: " & j, vbInformation, "Message"
            End If
        Next i
    Loop
Close #1

End Sub