Snasui Excel Forum

Code: Select all

Function gethtmltext(URL As String, savepath As String) As String

Dim ie As Object, objDoc As Object
Dim strURI As String
strURI = URL
Set ie = CreateObject("internetexplorer.application")
ie.navigate strURI
'Wait for page to load!
Do
If ie.readyState = 4 Then
ie.Visible = False
Exit Do
Else
DoEvents
End If
Loop

Set objDoc = ie.document

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile(savepath, True, True)
oFile.WriteLine objDoc.body.innerHTML 
oFile.Close
Set fso = Nothing
Set oFile = Nothing
gethtmltext = objDoc.body.innerHTML

ie.Quit
Set objDoc = Nothing
Set ie = Nothing
End Function

Code: Select all

Function gethtmltext(URL As String, savepath As String) As String

    Dim ie As Object, objDoc As Object
    Dim strURI As String
    strURI = URL
    Set ie = CreateObject("internetexplorer.application")
    ie.navigate strURI
    'Wait for page to load!
    
    DoEvents
    Do
        If ie.readyState = 4 Then
            ie.Visible = False
            Exit Do
        End If
    Loop
    
    Set objDoc = ie.document
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Dir(savepath) <> "" Then
        Dim ff As Long
        ff = FreeFile
        Open savepath For Append As #ff
        Print #ff, StrConv(objDoc.body.innerHTML, vbUnicode)
        Close #ff
    Else
        Dim oFile As Object
        Set oFile = fso.CreateTextFile(savepath, True, True)
        oFile.writeline objDoc.body.innerHTML
        oFile.Close
    End If

    Set fso = Nothing
    Set oFile = Nothing
    gethtmltext = objDoc.body.innerHTML
    
    ie.Quit
    Set objDoc = Nothing
    Set ie = Nothing
End Function