singh246
04-27-2016, 02:54 AM
Got the following code to extract data from the web.
Unfortunately I am getting occasional errors on:
Loop Until IE.readyState = READYSTATE_COMPLETE
I then have to stop the code, restart and hope it runs through 14 iterations.
I have been trying to add in something like if there is an error on that step to go back a redo it, but could't think of anything.
Any help is much appreciated!
The full code is below:
Sub ietest()
For i = 1 To 14
Application.StatusBar = "Progress: " & i & " of 14"
urlcurrent = Worksheets("URLs").Range("B1").Offset(i - 1, 0).Value
Dim IE As New InternetExplorer
'IE.Visible = True
IE.navigate urlcurrent
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = IE.document
If i < 9 Then
On Error GoTo Errhandler
Worksheets("Data").Range("B:B").Find(Date, LookIn:=xlValues).Offset(, i).Value = Doc.getElementById("resultcount").innerText
On Error GoTo 0
Else
If i < 11 Then
Worksheets("Data").Range("B:B").Find(Date, LookIn:=xlValues).Offset(, i + 1).Value = Doc.getElementById("resultcount").innerText
Else
Worksheets("Data").Range("B:B").Find(Date, LookIn:=xlValues).Offset(, i + 2).Value = Doc.getElementById("resultcount").innerText
End If
End If
Next i
Worksheets("Data").Range("B:B").Find(Date).Offset(, -1).Value = Time
Workbooks("RightmoveData.xlsm").Activate
Application.StatusBar = ""
Exit Sub
Errhandler:
Worksheets("Data").Range("B:B").Find(Date, LookIn:=xlValues).Offset(, i).Value = 0
Resume Next
End Sub
Unfortunately I am getting occasional errors on:
Loop Until IE.readyState = READYSTATE_COMPLETE
I then have to stop the code, restart and hope it runs through 14 iterations.
I have been trying to add in something like if there is an error on that step to go back a redo it, but could't think of anything.
Any help is much appreciated!
The full code is below:
Sub ietest()
For i = 1 To 14
Application.StatusBar = "Progress: " & i & " of 14"
urlcurrent = Worksheets("URLs").Range("B1").Offset(i - 1, 0).Value
Dim IE As New InternetExplorer
'IE.Visible = True
IE.navigate urlcurrent
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = IE.document
If i < 9 Then
On Error GoTo Errhandler
Worksheets("Data").Range("B:B").Find(Date, LookIn:=xlValues).Offset(, i).Value = Doc.getElementById("resultcount").innerText
On Error GoTo 0
Else
If i < 11 Then
Worksheets("Data").Range("B:B").Find(Date, LookIn:=xlValues).Offset(, i + 1).Value = Doc.getElementById("resultcount").innerText
Else
Worksheets("Data").Range("B:B").Find(Date, LookIn:=xlValues).Offset(, i + 2).Value = Doc.getElementById("resultcount").innerText
End If
End If
Next i
Worksheets("Data").Range("B:B").Find(Date).Offset(, -1).Value = Time
Workbooks("RightmoveData.xlsm").Activate
Application.StatusBar = ""
Exit Sub
Errhandler:
Worksheets("Data").Range("B:B").Find(Date, LookIn:=xlValues).Offset(, i).Value = 0
Resume Next
End Sub