Avoid crashing VBA when running IE web scraping multiple times - excel

Question

My excel crashes when I scrape a website for information multiple times, and insert it into cell
I already included in my code set IE = Nothing and IE Quit, but it doesn't change the fact that the code returns an error after multiple iterations
My code consists of a loop-part and the actual scraping. Here is the loop:
Public Sub LooperForMMDescription()
Dim currentValue As String
Dim dataList As Variant
Dim i As Integer
Dim n As Integer
Dim FirstRow As Integer
Dim IE As Object
n = 1
Set dataList = Range("Table6")
FirstRow = Range("Table6").Row - 1
'On Error Resume Next
Set IE = Nothing
For i = 1 To UBound(dataList.Value)
If IsEmpty(dataList.Value) Then
Exit Sub
Else
currentValue = dataList(i, 1).Text
If Len(currentValue) = 0 Then
GoTo ByPass
End If
Call MM_description(currentValue, n, FirstRow, IE)
ByPass:
n = n + 1
End If
Next i
Sheets("Input").Range("F7").Select
End Sub
And this is the actual scraping:
Public Sub MM_description(currentValue As String, n As Integer, FirstRow As Integer, IE As Object)
Dim html As HTMLDocument
Dim codeLine As String
Dim startPos As Long
Dim endPost As Long
Set IE = Nothing
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.Navigate2 (currentValue)
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
mes = IE.document.body.innerHTML
startPos = InStr(mes, "Description") + 61
endPos = InStr(mes, "Address")
If startPos = 0 Then
Sheets("Input").Range("F" & FirstRow + n).Value = "Not Found"
Else
codeLine = Mid(mes, startPos, endPos - startPos - 229)
Sheets("Input").Range("F" & FirstRow + n).Value = codeLine
End If
IE.Quit
Set IE = Nothing
End Sub
The code runs fine for 80-90 iterations, but then it returns an error

Answer 1

So, this is more of a code review than an answer. The following are notes on your code and a suggested re-write.
Use Long not Integer as this reduces the risk of overflow which can happen with Integer datatype particularly when dealing with loops of rows (there are more rows than Integer can handle). Additionally, there is no performance benefit here from Integer v Long.
Camelcase local variables
firstRow
Improve readability by using worksheet variables
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Use explicit sheet references not bug prone implicit Activesheet references. Using ws variable from above:
Range("Table6")
which has implicit Activesheet reference can have an explicit sheet reference
ws.Range("Table6")
dataList.value is a 2d array, as you are reading in a range from a worksheet:
For i = 1 To UBound(dataList.Value)
So, there should be a second dimension specified in your loop and it would be more efficient to read that 2d array into a variable, rather than incurring the repeated expensive i/o of going out to sheet for a value
I don't know what your table6 looks like but I suspect you are attempting to loop a specific column (likely the first)
You could then, instead, put the table into a variable and then read its first column values (excluding header) into a 1D array to loop. As you will later be writing out values to the sheet again, dimension an output array to the same dimensions as the array you are looping to store the results of your loop in
Dim arr(), table As ListObject, output()
Set table = ws.ListObjects("Table6")
arr = Application.Transpose(table.ListColumns(1).DataBodyRange.Value)
ReDim output(1 To UBound(arr))
This
If IsEmpty(dataList.Value) Then
Exit Sub
Else
is basically looking at whether the table databodyrange is empty. Assuming your are checking if there are any urls in column 1 of your table then this test is only needed
once before the loop and can be a one liner without the If Else End If
If IsEmpty(arr) Then Exit Sub
Consider renaming local variables to more useful/descriptive values: currentValue to currentUrl as this is more useful IMO.
This
If Len(currentValue) = 0 Then
GoTo ByPass
End If
is basically checking whether there is a value to pass as an url and using GoTo to handle not present. Avoid GoTo where possible as it makes code harder to read. It isn't needed here. You can use a quick vbNullString comparison, or even better Instr(url, "http") > 0 to validate the value you will be working with:
(I have switched from currentValue)
'initial code
If currentUrl <> vbNullString Then 'test
'call the sub and extract value
End If
n = n + 1 'increment....loop....rinse....repeat
Alterative validation:
If instr(currentUrl, "http") > 0 Then 'test
'call the sub and extract value
End If
n = n + 1 'increment....loop....rinse....repeat
As you already have a loop variable of i then n isn't really needed at all. Particularly in light of populating an output array at same indices.
ie is already nothing when you have Dim ie As..... You want to instantiate the object at the start
Set ie = CreateObject("InternetExplorer.Application")
Then work with that instance throughout your loop. You already include ie in your scraping sub signature, so it is expected that you will pass the same instance around:
Public Sub MM_description(currentValue As String, n As Long, firstRow As Long, ie As Object)
Add ByRef, ByVal to signature
Public Sub MM_description(ByVal currentValue As String, ByVal n As Long, ByVal firstRow As Long, ByVal ie As Object)
Remove redundant Call keyword when calling the sub and remove the () as this is a sub with params
Call MM_description(currentValue, n, firstRow, ie) > MM_description currentValue, n, firstRow, ie
As you are passing ie to the sub MM_description you don't want to then deference it and instantiate a new instance inside the called sub. So, remove
Set ie = Nothing
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
from inside MM_description
Inside the called sub:
Remove the () from
ie.Navigate2 (currentUrl)
So
ie.Navigate2 currentUrl
and use a proper page load wait. So replace:
Do While ie.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
with
while .busy or .readystate <> 4:wend
Remove unused variables e.g. Dim html As HTMLDocument, and declare all others that are used e.g. Dim mes As String. Put Option Explicit at the top of your module to check for consistency of variable spellings and declarations.
Now, I would actually convert this sub, MM_description, into a function that returns the scraped string value, or "Not Found", and populates the output array in the same loop which calls the function.
If this is now a function the signature needs a return type specified, the call to the function needs an assignment and the () come back as there is evaluation.
output(i) = MM_description(currentUrl, n, firstRow, ie)
Finally, write out the output array to whichever range you want the output values in one go.
Worksheets("Input").Range("F1").Resize(UBound(output), 1) = Application.Transpose(output)
Many of the above changes would lead to a structure like:
Option Explicit
Public Sub LooperForMMDescription()
Dim currentUrl As String, i As Long
Dim ie As Object, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set table = ws.ListObjects("Table6")
Dim arr(), table As ListObject, output()
arr = Application.Transpose(table.ListColumns(1).DataBodyRange.Value)
ReDim output(1 To UBound(arr))
Set ie = CreateObject("InternetExplorer.Application")
If IsEmpty(arr) Then Exit Sub
ie.Visible = True
For i = LBound(arr) To UBound(arr)
currentUrl = arr(i)
If InStr(currentUrl, "http") > 0 Then 'test
'call the sub and extract value
output(i) = MM_description(currentUrl, i, ie)
End If
Next i
ie.Quit
ThisWorkbook.Worksheets("Input").Range("F1").Resize(UBound(output), 1) = Application.Transpose(output)
End Sub
Public Function MM_description(ByVal currentUrl As String, ByVal i As Long, ByVal ie As Object) As String
Dim codeLine As String, startPos As Long, endPos As Long, mes As String
With ie
.Navigate2 currentUrl
While .Busy Or .readyState < 4: DoEvents: Wend
mes = .document.body.innerHTML
startPos = InStr(mes, "Description") + 61
endPos = InStr(mes, "Address")
If startPos = 0 Then
MM_description = "Not Found"
Else
codeLine = Mid$(mes, startPos, endPos - startPos - 229)
MM_description = codeLine
End If
End With
End Function