438错误VBA Excel从超链接中抓取

Question

I have the below code, as I am trying to scrape the text from some webpages. Currently I have the excel set up such that I put in a hyperlink in column A, and it cycles through and pulls all the text from the web page into excel. However, I keep getting a

438 error

on the ie.document.body.innertext line.

Does anyone know why this may be happening? I have searched around a fair bit, but I have not had much success as it seems this is a fairly common problem but with many different causes. Any help would be greatly appreciated, and apologies in advance for anything obvious, as I am rather new to VBA.

Sub Sample()
Dim ie As Object
Dim retStr As String
Dim sht As Worksheet
Dim LastRow As Long
Dim rCell As Range
Dim rRng As Range

Set sht = ThisWorkbook.Worksheets("Sheet1")

'Ctrl + Shift + End
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

Set ie = CreateObject("internetexplorer.application")


Set rRng = Sheet1.Range("A1:A" & LastRow)

For Each rCell In rRng.Cells

        With ie
            .Navigate rCell.Value
            .Visible = True
        End With

        Do While ie.readystate <> 4: Wait 5: Loop
        DoEvents

        rCell.Offset(0, 1).Value = ie.document.body.innerText
Next rCell

End Sub

Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
    DoEvents
Wend
End Sub

Answer 1

Do you really need the IE to do the job? Maybe better try HTTP request?

Dim xHttp As MSXML2.XMLHTTP
Dim hDoc As MSHTML.HTMLDocument

Set rRng = Sheet1.Range("A1:A" & LastRow)

For Each rCell In rRng.Cells
    Set xHttp = New MSXML2.XMLHTTP
    xHttp.Open "GET", rCell.Value
    xHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    xHttp.send

    Do Until xHttp.READYSTATE = 4
        DoEvents
    Loop

    If xHttp.Status = 200 Then
        rCell.Offset(0, 1).Value = xHttp.responseText
    End If
Next rCell