If you have a business account for Google Mapping, you’ll need to provide your client id and crypto key. These things are meant to be kept private, so I did not provide a mechanism for parameterization of the url to include these. However I have provided the encryption functions needed to generate them from VBA. You’ll find all this in the latest version of googlemapping.xlsm, downloadable from here.
apiKeys module
You need to modify two functions here to supply your key and your clientID. Substitute your key value and clientID. You can obtain them here from the registry or however you choose to protect them. You simply need to return them as below.
Public Function addClientId() As String
'--------------change this to the correct thing
addClientId = "&client=" & "yourclientID"
End Function
Public Function addSignature(url As String) As String
Dim keyString As String
'-----------change this to the correct thing - should be hidden
keyString = "vNIXE0xscrmjlyV-12Nj_BvUPaw="
addSignature = url & createSignature(keyString, url)
End Function
googleMaps module
For the moment, I’ve only applied this to the section that does geoCoding, since this is rate limited section. If you need the keys you specified in the apiKeys module to be used, then uncomment the code below in the googleMaps module so that it will create a signature for each query it does
' -- uncomment this line if you have a business account
' -- you will need to modify the apiKeys module to supply your credentials however you store them
'sReq = addSignature(sReq & addClientId())
'------------------------------
Implementation details
Google do point you at how to do this using various other languages, but there is not a VBA solution, so below is how to do it.
The url is signed by hashing your query url and your key using SHA1 encryption. VBA doesn’t have the ability to do that directly, but a solution can be hacked together, mainly from clues on various stackoverflow postings (apologies for not crediting them here- i didn’t keep track). These have been implemented in the apikeys module.
Private Function createSignature(keyString As String, url As String) As String
' should get this from some secure place
Dim effectiveUrl As String, k As Long, h As String
' strip domain - just a temp solution
k = InStr(1, url, "/maps/api/")
effectiveUrl = Mid(url, k, Len(url) - k + 1)
h = sha1(keyString, effectiveUrl)
createSignature = "&signature=" & h
End Function
Private Function sha1(ByVal keyString As String, ByVal str As String) As String
Dim encode As Object, encrypt As Object, s As String, _
t() As Byte, b() As Byte, privateKeyBytes() As Byte
Set encode = CreateObject("System.Text.asciiEncoding")
Set encrypt = CreateObject("System.Security.Cryptography.HMACSHA1")
s = Replace(keyString, "-", "+")
s = Replace(s, "_", "/")
privateKeyBytes = decodeBase64(s)
encrypt.key = privateKeyBytes
t = encode.Getbytes_4(str)
b = encrypt.ComputeHash_2((t))
s = tob64(b)
s = Replace(s, "+", "-")
sha1 = Replace(s, "/", "_")
Set encode = Nothing
Set encrypt = Nothing
End Function
Private Function tob64(ByRef arrData() As Byte) As String
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
' byte array to base64
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
tob64 = objNode.Text
Set objNode = Nothing
Set objXML = Nothing
End Function
Private Function decodeBase64(ByVal strData As String) As Byte()
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.Text = strData
decodeBase64 = objNode.nodeTypedValue
Set objNode = Nothing
Set objXML = Nothing
End Function
For more on mapping see, Using Google Maps. For help and more information join our forum,follow the blog or follow me on Twitter .