PDA

View Full Version : Web Scraping - Why does the code stop?



Enright
08-04-2016, 01:28 PM
Hello,

The below code will scrape text from the website URL listed in column A.

However, it stops after just a handful of lines.... what am I missing? Thank you very much.


Sub Scraper()
Dim wb As Object
Dim doc As Object
Dim sURL As String
Dim lastrow As Long
Dim i As Integer


lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row


For i = 2 To lastrow
Application.Wait (Now + #12:00:02 AM#)


Set wb = CreateObject("internetExplorer.Application")
sURL = Cells(i, 1)


wb.navigate sURL
wb.Visible = True


While wb.Busy
DoEvents
Wend


'HTML document
Set doc = wb.document


Cells(i, 2) = doc.Title


On Error GoTo err_clear


Dim el As Object
For Each el In doc.GetElementsByTagName("p")


counter = counter + 1
Cells(i, counter + 2).Value = Cells(counter + 1).Value & el.innerText


Next el
counter = 0


err_clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
wb.Quit
Range(Cells(i, 1), Cells(i, 10)).Columns.AutoFit
Next i


End Sub

Kenneth Hobs
08-04-2016, 02:10 PM
Since you are dealing with rows, dim your i as Long.

Try this sort of thing..

Sub MSIE()
Dim lnk As Object, ie As Object, doc As Object, i As Long
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate "http://www.vbaexpress.com/forum/showthread.php?56801-Web-Scraping-Why-does-the-code-stop"
Do Until .readyState = 4: DoEvents: Loop
Set doc = ie.document

For Each lnk In doc.Links
'If lnk.Classname = "topictitle" Then
i = i + 1
Range("A" & i) = lnk.innerText
Range("B" & i) = lnk
'End If
Next lnk
End With
End Sub