Analyze Google API for latitude & longitude of adress - Regex.pattern issue

[Lasse97]

Hi all!

I'm currently stuck with this Google API Query.
As you may know you can get information about longitude, latitude etc. via Google API. This is done via this web query: "https://maps.googleapis.com/maps/api/geocode/json?address=NewYorkUSA" (example for New York).

But in my excel sheet I have many other cities left, therefore I'd like to do this automatically. It actually works nearly perfect with a slight modification of this guys' code: http://analystcave.com/excel-calcula...een-addresses/
And yes, I have seen his solution to getting the longitudes and latitudes. But that is written as a SUB and not as a function. Unfortunately I need this as a function for my specific usage :/


My modified code:

'Latitude via Google Maps
Public Function GetLatitude(start As String)
    Dim firstVal As String
    firstVal = "https://maps.googleapis.com/maps/api/geocode/json?address="
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    URL = firstVal & Replace(start, " ", "+")
    objHTTP.Open "GET", URL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    If InStr(objHTTP.responseText, """location"" : {") = 0 Then GoTo ErrorHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """lat"".*?([0-9]+)": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
    GetLatitude = CDbl(tmpVal)
    Exit Function
ErrorHandl:
    GetLatitude = 0
End Function

But if I then start this function as following, the value of the function is "40".
But the difference of one degree of latitude equals 110km, while I need an exact analysis of all digits.

City	Latitude
New York	=GetLatitude(A2)=40

Therefore I fooled a bit around with following passage:

Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """lat"".*?([0-9]+)": regex.Global = False

In my understanding the issue here is the search pattern which only gives whole numbers as output, therefore I changed it to:

Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """lat"".*?([0.-9]+)": regex.Global = False

I even checked it with a regex-analyzer and it worked. Unfortunately not with Excel 2007.


Has someone maybe an idea, how Excel could deliver the output with the whole decimal number?

Many thanks!!

Best Regards,
Lasse

[jindon]

1)
Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Click on Edit to open your thread, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

2) Try change

regex.Pattern = """lat"".*?([0-9]+)"

to

regex.Pattern = """lat"".*?(\d+(\.\d+)?)"

[Lasse97]

Thanks for your answer!

Just edited the thread to comply with the forum rules - sorry about that!

Unfortunately I do still get an error with this pattern. To make it a bit easier, I've attached an little example with the city New York.
The VBA macro is in module 1 - just as mentioned in this thread. Nothing else attached.

[Kenneth Hobson]

I don't know about an error. Maybe not getting the answer that you want.

Just what part of this did you want?

"formatted_address" : "New York, NY, USA",
"geometry" : {
"bounds" : {
"northeast" : {
"lat" : 40.9175771,
"lng" : -73.70027209999999
},
"southwest" : {
"lat" : 40.4773991,
"lng" : -74.25908989999999
}
},
"location" : {
"lat" : 40.7127837,
"lng" : -74.0059413
},
"location_type" : "APPROXIMATE",
"viewport" : {
"northeast" : {
"lat" : 40.9175771,
"lng" : -73.70027209999999
},
"southwest" : {
"lat" : 40.4773991,
"lng" : -74.25908989999999

[bakerman2]

This works for me.

'Latitude via Google Maps
Public Function GetLatitude(start As String)
Dim firstVal As String
firstVal = "https://maps.googleapis.com/maps/api/geocode/json?address="
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = firstVal & Replace(start, " ", "+")
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.Send ("")
If InStr(objHTTP.responseText, """location"" : {") = 0 Then GoTo ErrorHandl
Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """lat"".*?(\d+\.\d+)": regex.Global = False
Set matches = regex.Execute(objHTTP.responseText)
GetLatitude = Replace(matches(0).SubMatches(0), ".", Application.International(xlDecimalSeparator))
Exit Function
ErrorHandl:
GetLatitude = 0
End Function

[jindon]

Lasse97,

I would go like this.

B2:
=GetLatLng(A2,"lat")
C2:
=GetLatLng(A2,"lng")

'Latitude or Longitude via Google Maps
Public Function GetLatLng(start As String, LtLn As String)
    Dim firstVal As String, txt As String
    firstVal = "https://maps.googleapis.com/maps/api/geocode/json?address="
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    URL = firstVal & Replace(start, " ", "+")
    objHTTP.Open "GET", URL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    txt = objHTTP.responseText
    If InStr(txt, """location"" : {") = 0 Then GoTo ErrorHandl
    With CreateObject("VBScript.RegExp")
        .Pattern = """" & LtLn & """ *: *([+-]?\d+(\.\d+)?)"
        If .test(txt) Then
            GetLatLng = Replace(Val(.Execute(txt)(0).SubMatches(0)), _
                       ".", Application.International(xlListSeparator))
        End If
    End With
    Exit Function
ErrorHandl:
    GetLatitude = 0
End Function

[bakerman2]

@ jindon

Typo.

GetLatLng = 0

[jindon]

Lasse97

I don't think you need an error trap.
Try the attached.

Public Function GetLatLng(start As String, LtLn As String)
    Dim firstVal As String, URL As String, txt As String
    firstVal = "https://maps.googleapis.com/maps/api/geocode/json?address="
    URL = firstVal & Replace(start, " ", "+")
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "GET", URL, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        .send ("")
        txt = .responseText
    End With
    LtLn = LCase$(LtLn)
    With CreateObject("VBScript.RegExp")
        If LtLn = "address" Then
            GetLatLng = ""
            .Pattern = """formatted_address"" *: *""(.+?)"""
            If .test(txt) Then GetLatLng = .Execute(txt)(0).submatches(0)
        Else
            .Pattern = """" & LtLn & """ *: *([+-]?\d+(\.\d+)?)"
            If .test(txt) Then
                GetLatLng = Replace(Val(.Execute(txt)(0).submatches(0)), _
                           ".", Application.International(xlDecimalSeparator))
            End If
        End If
    End With
End Function

Edit:
Replaced xlListSeparator with xlDecimalSeparator

[Lasse97]

Hi there,

the solution of jindon works just perfectly!
Many thanks to you all. Definitely have to check out these patterns and trap issues in more detail.

[jindon]

Lasse9,

I've just found the symbolic figures.
If you put any city in A2, it points to the City hall in most cases.
And also fixed the error when exceeds the connection limit.

Try

Public Function GetLatLng(start As String, LtLn As String)
    Dim firstVal As String, URL As String, txt As String
    firstVal = "https://maps.googleapis.com/maps/api/geocode/json?address="
    URL = firstVal & Replace(start, " ", "+")
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "GET", URL, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        .send ("")
        txt = .responseText
    End With
    If InStr(txt, "error_message") Then GetLatLng = GetLatLng(start, LtLn)
    LtLn = LCase$(LtLn)
    With CreateObject("VBScript.RegExp")
        .Pattern = "formatted_address"" *: *""(.+?)"",([\r\n]+.+)+?""location_type"" :"
        If .test(txt) Then
            txt = .Execute(txt)(0)
        Else
            Exit Function
        End If
        If LtLn = "address" Then
            GetLatLng = ""
            .Pattern = "formatted_address"" *: *""(.+?)"""
            If .test(txt) Then GetLatLng = .Execute(txt)(0).submatches(0)
        Else
            .Pattern = "location"" *:.+([\r\n]+.+)+?\}"
            txt = .Execute(txt)(0)
            .Pattern = """" & LtLn & """ *: *([+-]?\d+(\.\d+)?)"
            If .test(txt) Then GetLatLng = Replace(Val(.Execute(txt)(0).submatches(0)), _
                                ".", Application.International(xlDecimalSeparator))
        End If
    End With
End Function