· 2 years ago · Apr 26, 2023, 08:38 PM
1Option Explicit
2
3Function GetCoordinates(Address As String) As String
4
5 '-----------------------------------------------------------------------------------------------------
6 'This function returns the latitude and longitude of a given address using the Google Geocoding API.
7 'The function uses the "simplest" form of Google Geocoding API (sending only the address parameter),
8 'so, optional parameters such as bounds, language, region and components are NOT used.
9 'In case of multiple results (for example two cities sharing the same name), the function
10 'returns the FIRST OCCURRENCE, so be careful in the input address (tip: use the city name and the
11 'postal code if they are available).
12
13 'NOTE: As Google points out, the use of the Google Geocoding API is subject to a limit of 40,000
14 'requests per month, so be careful not to exceed this limit. For more info check:
15 'https://cloud.google.com/maps-platform/pricing/sheet
16
17 'In order to use this function you must enable the XML, v3.0 library from VBA editor:
18 'Go to Tools -> References -> check the Microsoft XML, v3.0.
19 'If you don't have the v3.0 use any other version of it (e.g. v6.0).
20
21 '2018 Update: In order to use this function you will now need a valid API key.
22 'Check the next link that guides you on how to acquire a free API key:
23 'https://www.myengineeringworld.net/2018/02/how-to-get-free-google-api-key.html
24
25 '2018 Update 2 (July): The EncodeURL function was added to avoid problems with special characters.
26 'This is a common problem with addresses that are from Greece, Serbia, Germany and other countries.
27
28 'Written By: Christos Samaras
29 'Date: 12/06/2014
30 'Last Updated: 09/08/2018
31 'E-mail: xristos.samaras@gmail.com
32 'Site: https://www.myengineeringworld.net
33 '-----------------------------------------------------------------------------------------------------
34
35 'Declaring the necessary variables.
36 'The first 2 variables using 30 at the end, corresponding to the "Microsoft XML, v3.0" library
37 'in VBA (msxml3.dll). If you use any other version of it (e.g. v6.0), then declare these variables
38 'as XMLHTTP60 and DOMDocument60 respectively.
39 Dim ApiKey As String
40 Dim Request As New XMLHTTP30
41 Dim Results As New DOMDocument30
42 Dim StatusNode As IXMLDOMNode
43 Dim LatitudeNode As IXMLDOMNode
44 Dim LongitudeNode As IXMLDOMNode
45
46 'Set your API key in this variable. Check this link for more info:
47 'https://www.myengineeringworld.net/2018/02/how-to-get-free-google-api-key.html
48 ApiKey = "AIzaSyBK5Z4iD0zoJak3XMjsohjT9vfAgC1lsTU"
49
50 'Check that an API key has been provided.
51 If ApiKey = vbNullString Or ApiKey = "Your API Key goes here!" Then
52 GetCoordinates = "Invalid API Key"
53 Exit Function
54 End If
55
56 'Generic error handling.
57 On Error GoTo errorHandler
58
59 'Create the request based on Google Geocoding API. Parameters (from Google page):
60 '- Address: The address that you want to geocode.
61
62 'Note: The EncodeURL function was added to allow users from Greece, Poland, Germany, France and other countries
63 'geocode address from their home countries without a problem. The particular function (EncodeURL),
64 'returns a URL-encoded string without the special characters.
65 Request.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?" _
66 & "&address=" & Application.EncodeURL(Address) & "&key=" & ApiKey, False
67
68 'Send the request to the Google server.
69 Request.send
70
71 'Read the results from the request.
72 Results.LoadXML Request.responseText
73
74 'Get the status node value.
75 Set StatusNode = Results.SelectSingleNode("//status")
76
77 'Based on the status node result, proceed accordingly.
78 Select Case UCase(StatusNode.Text)
79
80 Case "OK" 'The API request was successful. At least one geocode was returned.
81
82 'Get the latitude and longitude node values of the first geocode.
83 Set LatitudeNode = Results.SelectSingleNode("//result/geometry/location/lat")
84 Set LongitudeNode = Results.SelectSingleNode("//result/geometry/location/lng")
85
86 'Return the coordinates as a string (latitude, longitude).
87 GetCoordinates = LatitudeNode.Text & ", " & LongitudeNode.Text
88
89 Case "ZERO_RESULTS" 'The geocode was successful but returned no results.
90 GetCoordinates = "The address probably not exists"
91
92 Case "OVER_QUERY_LIMIT" 'The requestor has exceeded the limit of 2500 request/day.
93 GetCoordinates = "Requestor has exceeded the server limit"
94
95 Case "REQUEST_DENIED" 'The API did not complete the request.
96 GetCoordinates = "Server denied the request"
97
98 Case "INVALID_REQUEST" 'The API request is empty or is malformed.
99 GetCoordinates = "Request was empty or malformed"
100
101 Case "UNKNOWN_ERROR" 'Indicates that the request could not be processed due to a server error.
102 GetCoordinates = "Unknown error"
103
104 Case Else 'Just in case...
105 GetCoordinates = "Error"
106
107 End Select
108
109 'In case of error, release the objects.
110errorHandler:
111 Set StatusNode = Nothing
112 Set LatitudeNode = Nothing
113 Set LongitudeNode = Nothing
114 Set Results = Nothing
115 Set Request = Nothing
116
117End Function
118
119'-------------------------------------------------------------------------------------------------------------------
120'The next two functions using the GetCoordinates function to get the latitude and the longitude of a given address.
121'-------------------------------------------------------------------------------------------------------------------
122
123Function GetLatitude(Address As String) As Double
124
125 'Declaring the necessary variable.
126 Dim Coordinates As String
127
128 'Get the coordinates for the given address.
129 Coordinates = GetCoordinates(Address)
130
131 'Return the latitude as a number (double).
132 If Coordinates <> vbNullString Then
133 GetLatitude = CDbl(Left(Coordinates, WorksheetFunction.Find(",", Coordinates) - 1))
134 Else
135 GetLatitude = 0
136 End If
137
138End Function
139
140Function GetLongitude(Address As String) As Double
141
142 'Declaring the necessary variable.
143 Dim Coordinates As String
144
145 'Get the coordinates for the given address.
146 Coordinates = GetCoordinates(Address)
147
148 'Return the longitude as a number (double).
149 If Coordinates <> vbNullString Then
150 GetLongitude = CDbl(Right(Coordinates, Len(Coordinates) - WorksheetFunction.Find(",", Coordinates)))
151 Else
152 GetLongitude = 0
153 End If
154
155End Function
156
157