CODEWITHSUNDEEP
excelvbaweb-scraping
Rajput
Rajput

Reputation: 605

Code Works on Excel 2016 but not works for 2010

I have created this below code which works on Excel 2016 but do not work on Excel 2010 an error appear that is run time error 13 type mismatch vba on Set doc = ie.document.

But i am unable to figure it out for Excel 2010 how it will fix.

One more thing i want to make it work faster then now. I will appreciate any help.

Sub Link()

Dim ie As New InternetExplorer
Dim doc As New HTMLDocument
Dim lastrow As Long
Dim ecoll As Object
Dim ecolla As Object
Dim link As Object
Dim t As Date

lastrow = Range("A" & Rows.Count).End(xlUp).Row

t = Now()
'MsgBox "Do you want to initialize this COOL Scraper?"

For i = 2 To lastrow

    ie.Visible = True
    ie.navigate "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)
    
    Do
    DoEvents
    Loop Until ie.readyState = READYSTATE_COMPLETE
  
    Set doc = ie.document


    Set ecoll = doc.getElementById("rso")
    Set ecolla = ecoll.getElementsByTagName("H3")(0)
    Set link = ecolla.parentNode
    On Error Resume Next
    str_text = Replace(link.innerText, link.href, "")
    On Error Resume Next
    str_text = Replace(str_text, " ", "")
    
    
    Cells(i, 2) = link.href
    DoEvents
    
    Next
    ie.Quit
Set ie = Nothing


Debug.Print "done" & "Time taken : " & Format(Now() - t, "hh:mm:ss")
MsgBox "Ellapsed Time - " & Format(Now() - t, "hh:mm:ss")

End Sub

Upvotes: 0

Views: 82

Answers (1)

Raymond Wu
Raymond Wu

Reputation: 3387

It might not work on your machine but try using XMLHTTP, if it works then all the better since it's faster without having to open a browser:

Sub link()
    Dim doc As HTMLDocument
    Set doc = New HTMLDocument
    
    Dim lastrow As Long
    Dim ecoll As Object
    Dim link As Object
    Dim t As Date
    
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    
    t = Now()
    'MsgBox "Do you want to initialize this COOL Scraper?"
    
    Dim reqObj As Object
    Set reqObj = CreateObject("MSXML2.XMLHTTP")
        
    For i = 2 To lastrow
            
        reqObj.Open "GET", "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000), False
        reqObj.send
        
        doc.body.innerHTML = reqObj.responseText
        
    
        Set ecoll = doc.getElementById("rso")
        Set link = ecoll.getElementsByTagName("a")(0)
            
        Cells(i, 2) = link.href
    Next
    
    Set doc = Nothing
    Set reqObj = Nothing
    
    Debug.Print "done" & "Time taken : " & Format(Now() - t, "hh:mm:ss")
    MsgBox "Ellapsed Time - " & Format(Now() - t, "hh:mm:ss")
End Sub

Upvotes: 2

Related Questions