• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

scrapping data from specific site

Since Google API has query limit. I typically pilot IE and use following.

Assuming you have table1 like below.
upload_2018-8-20_16-48-6.png

Code: 
Function GetCurrentURL()
Dim vUrl As String
Set SWs = New SHDocVw.ShellWindows

For Each vIE In SWs
    If TypeName(vIE.document) = "HTMLDocument" Then
        vUrl = vIE.document.Url
        Exit For
    End If
Next
GetCurrentURL = vUrl
End Function

Sub LatLong()
Dim cel As Range
Dim sStr As String, ltlng As String
Dim iMax As Long, i As Long: i = 0
Dim IE As InternetExplorer

iMax = 5000

For Each cel In Sheet1.Range("Table1[Street]").SpecialCells(xlCellTypeVisible).Cells
    If Len(cel.Offset(, 2).Value) = 0 Then
        sStr = cel.Value & ", " & cel.Offset(, -1).Value
        Set IE = New InternetExplorer
        IE.Visible = True
        IE.navigate "www.google.ca/maps?q=" & sStr
        While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
        Application.Wait (Now + TimeValue("0:00:05"))
        ltlng = Split(Split(GetCurrentURL(), "@")(1), ",17z")(0)
        cel.Offset(, 2) = CDbl(Split(ltlng, ",")(0))
        cel.Offset(, 3) = CDbl(Split(ltlng, ",")(1))
        IE.Quit
        Set IE = Nothing
        i = i + 1
    If i = iMax Then Exit For
    End If
    Application.StatusBar = "Progress: " & i & " of " & iMax & " " & Format(i / iMax, "Percent")
Next
Application.StatusBar = False
End Sub

Since this process is prone to crashing after running it for a while. I tend to limit it to 5000 or less per run.

Result:
upload_2018-8-20_16-55-56.png
 
Last edited:
Marc L said:
Try to restart from page #701 …


Any geographic website can display the coordinates …
Comparing with coordinates from G.Maps it's pretty close.
For the reliability compare for example with the GPS of your car
or from coordinates you already know …
​
Click to expand...


I will try not to block the macro and keep it running for several hours and tomorrow I'll try it from a fixed pc, we'll see what happens.
Do you know any site that calculates the coordinates that is reliable for multiple instances and how accurate?
 
Thanks Chihiro. This afternoon I will test this macro ..

So just reboot the macro several times to go over the 5000 instances right?
With a macro you can reproduce the actions of closing and opening a file (with consequent start of the macro) planned over time?

By combining different macros I could start from the names of the schools (obtained from the maps.me site) and subsequently obtain the geographical coordinates and probably also the remaining data such as the street, the website and the contact emails. It will be a longer but complete process.
 
I tried again to extract the schools of my country leaving the PC on because I had to go out. I'm back and I saw that the macro has completed its cycle.
It will be that using the PC to do something else will negatively affect the macro. Being so many results you have to wait more time.

I also checked the coordinates of the schools as suggested by Marc and I noticed that they are accurate. I wonder how they did it because I live in a small town and I do not think anyone is going to communicate this data accurately.
Even by telephone, a person must go to the point where there is an institution and report it at that time. Too strange ..

I noticed that there are no schools in a city near mine. Even if there are not all the schools, there are many good ones.

Marc. Tomorrow I could try to leave the working pc all night and I could extract all the schools in your state. Do you want?
 

No thanks as first I very do not need that and as my country is from
the 5 bigger ones when surfing manually this website yet crashes …​
 
Chihiro said:
Since Google API has query limit. I typically pilot IE and use following.

Assuming you have table1 like below.
View attachment 54630

Code: 
Dim vUrl As String
Set SWs = New SHDocVw.ShellWindows

For Each vIE In SWs
    If TypeName(vIE.document) = "HTMLDocument" Then
        vUrl = vIE.document.Url
        Exit For
    End If
Next
GetCurrentURL = vUrl
End Function

Sub LatLong()
Dim cel As Range
Dim sStr As String, ltlng As String
Dim iMax As Long, i As Long: i = 0
Dim IE As InternetExplorer

iMax = 5000

For Each cel In Sheet1.Range("Table1[Street]").SpecialCells(xlCellTypeVisible).Cells
    If Len(cel.Offset(, 2).Value) = 0 Then
        sStr = cel.Value & ", " & cel.Offset(, -1).Value
        Set IE = New InternetExplorer
        IE.Visible = True
        IE.navigate "www.google.ca/maps?q=" & sStr
        While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
        Application.Wait (Now + TimeValue("0:00:05"))
        ltlng = Split(Split(GetCurrentURL(), "@")(1), ",17z")(0)
        cel.Offset(, 2) = CDbl(Split(ltlng, ",")(0))
        cel.Offset(, 3) = CDbl(Split(ltlng, ",")(1))
        IE.Quit
        Set IE = Nothing
        i = i + 1
    If i = iMax Then Exit For
    End If
    Application.StatusBar = "Progress: " & i & " of " & iMax & " " & Format(i / iMax, "Percent")
Next
Application.StatusBar = False
End Sub

Since this process is prone to crashing after running it for a while. I tend to limit it to 5000 or less per run.

Result:
View attachment 54631
Click to expand...


Hi Chihiro.
I tried the macro on the geographical coordinates.
I entered the data as you indicated and when you start the macro appears a mask with the following message:
compilation error
not valid outside a routine
Clicking on the question mark opens this link:
https://docs.microsoft.com/it-it/of...edure?f1url=https://msdn.microsoft.com/query% 2Fdev11.query% 3FappId% 3DDev11IDEF1% 26l% 3Dit-EN% 26k% 3DK (vblr6.chm1040051)% 3BK (TargetFrameworkMoniker-Office.Version 3Dv15%)%% 26rd 3Dtrue
Did I do something wrong?
Thank you
 
My bad, it was missing first line when I copied.
Add at the very top...
Code: 
Function GetCurrentURL()
 
Chihiro said:
My bad, it was missing first line when I copied.
Add at the very top...
Code: 
Function GetCurrentURL()
Click to expand...


However, despite the change from another error:
compilation error
type not defined by the user
highlight this part of the macro:
New SHDocVw.ShellWindows
the link to the explanation of the macro:
https://docs.microsoft.com/it-it/of...vblr6-chm1032807?f1url=https://msdn.microsoft. com 2Fquery%%% 2Fdev11.query 3FappId% 3DDev11IDEF1% 26l% 3Dit-EN% 26k% 3DK (vblr6.chm1032807)% 3BK (TargetFrameworkMoniker-Office.Version 3Dv15%)%% 26rd 3Dtrue
 
?
Go to VBE, Tools->References.

Scroll down the list and find "Microsoft Internet Controls" and tick the checkbox.

upload_2018-8-22_11-45-41.png
 
Chihiro. Another mistake.
Run time error 424
Necessary object
clicking on debud this line is highlighted:
For Each cel In Sheet1.Range ("Table1 [Street]"). SpecialCells (xlCellTypeVisible) .Cells
By clicking on the question mark, refer to this internet page:
https://docs.microsoft.com/it-it/of...d-error-424?f1url=https://msdn.microsoft.com% 2Fquery 2Fdev11.query%%% 3FappId 3DDev11IDEF1% 26l% 3Dit-EN% 26k% 3DK (vblr6.chm1000424)% 3BK (TargetFrameworkMoniker-Office.Version 3Dv15%)%% 26rd 3Dtrue
Why in the photo you have attached to you there is the 16th version of Microsoft Excel and Office while I have 15? it's normal?
 
... 16th version of Microsoft Excel and Office while I have 15? it's normal?
Click to expand...

Yes. It just means you have Excel 2013 and I use Office 365 (Excel 2016).

Code works for any Excel version after 2007 (I believe that's when Excel Table was properly introduced).
 
Upload sample. I doubt that you have the necessary table. You could always change code to use cell reference instead of Table column.
 
Yep, it's just filtered range.

Remove filter. Then select A1:G2.

Go to Home tab of ribbon and click on "Format as Table". Select the style you want, and make sure you check "My table has headers".
 
Hi Chihiro.
I followed your advice again and I did not get the result.
I compiled a line indicating in cell h2 the coordinates taken from the google maps address bar.
 

Attachments

  • GEOGRAPHIC COORDINATES- CHIHIRO.xlsm
    17.2 KB · Views: 2
Last edited by a moderator:
Can you help me with the automatic link selection of each state?
They are hurting my eyes and my neck to always be at the PC to do copy and paste :(
 
So your Excel isn't in English.
Change... For Each... line to something like below.
Code: 
For Each cel In Foglio1.Range("Tabella1[Street]").SpecialCells(xlCellTypeVisible).Cells
 
Chihiro said:
So your Excel isn't in English.
Change... For Each... line to something like below.
Code: 
For Each cel In Foglio1.Range("Tabella1[Street]").SpecialCells(xlCellTypeVisible).Cells
Click to expand...

I changed the values and now this other error presents itself:

run time error 9 'index not included in the interval'
debugging:ltlng = Split (Split (GetCurrentURL (), "@") (1), ", 17z") (0)
is the custom column used when you do not know all the other data accurately?
 
You must log in or register to reply here.
Back
Top