VBA code scraping from google

imran ashraf

New Member
Joined
Nov 15, 2016
Messages
39
Respected Mentors,
Please help , I have a excel VBA code that find the website URL's from the Name's of company'es but i also want to import email address as well from names or from website URLs from google or map.
Many Thanks
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
This is currently VBA code that import the URL of co from google search but i need also emails as well.
<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">Sub XMLHTTP()

Dim url As String, lastRow As Long
Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
Dim start_time As Date
Dim end_time As Date

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

Dim cookie As String
Dim result_cookie As String

start_time
= Time
Debug
.Print "start_time:" & start_time

For i = 2 To lastRow

url
= "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
XMLHTTP
.Open "GET", url, False
XMLHTTP
.setRequestHeader "Content-Type", "text/xml"
XMLHTTP
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
XMLHTTP
.send

Set html = CreateObject("htmlfile")
html
.body.innerHTML = XMLHTTP.ResponseText
Set objResultDiv = html.getelementbyid("rso")
Set objH3 = objResultDiv.getelementsbytagname("H3")(0)
Set link = objH3.getelementsbytagname("a")(0)


str_text
= Replace(link.innerHTML, "<EM>", "")
str_text
= Replace(str_text, "</EM>", "")

Cells
(i, 2) = str_text
Cells
(i, 3) = link.href
DoEvents
Next

end_time
= Time
Debug
.Print "end_time:" & end_time

Debug
.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
MsgBox
"done" & "Time taken : " & DateDiff("n", start_time, end_time)
End Sub</code>
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top