Excel VBA to parse JSON out of Google Maps API

Question

Some code that I wrote and broke into 5 separate questions on stack overflow. Some guy wanted to query Google Maps receive some JSON and then for each result found within that JSON do another query. I didn;t quite understand what he wanted at first and so actually there is some superfluous code here but I thought it would be useful to park my findings as to good practices for parsing JSON.

I use XHR requests. To parse the JSON, I use the ScriptControl. I have used this before. I have also seen a number of stack overflow questions which advocate third party libraries and I was puzzled by this. They all seem to take a mini-script approach of adding some javascript code to the script engine and calling it is cool but perhaps used too widely when there is a native solution available.

The key finding here is the use of VBA's CallByName function which can be used to query a JScriptTypeInfo Object Instance i.e. that which comes out of ScriptControl's Eval method.

CallByName can be used to get a member value; it can be used to query length of an array; it can be used to access elements of an array all with any javascript. Further I found some hasOwnProperty() method which allows defensive programming, so call this in cases where one thinks a member is missing. I also found some debugging sugar to stringify variables.

Look for some code review here. Will entertain suggestions, looking for best practice because in future looking to build J2EE application with REST interfaces that will use JSON and was planning to use Excel VBA as a debugging front end tool. Thanks.

'Tools->References->
'Microsoft Scripting Runtime
'Microsoft Script Control 1.0; {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx
'Microsoft Xml, v6.0
Option Explicit
Option Private Module
Private Const sKEYNAME As String = "Server key 1"
'Public Const sKEY As String = "Your key goes here and uncomment"
Private Const sSEVENOAKS_PLACEID As String = "ChIJwd9bXUyt2EcRYv6GY0JRnCw" 'Place ID: ChIJwd9bXUyt2EcRYv6GY0JRnCw Sevenoaks , Sevenoaks, Kent, UK
Private Const sSEVENOAKS_LATITUDE_LONGITUDE As String = "51.2724,0.1909" '51.2724° N, 0.1909° E
Private Function GetScriptEngine() As ScriptControl
 Static soScriptEngine As ScriptControl
 If soScriptEngine Is Nothing Then
 Set soScriptEngine = New ScriptControl
 soScriptEngine.Language = "JScript"
 soScriptEngine.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
 soScriptEngine.AddCode "function getKeyValues(jsonObj) { " & _
 " var dictionary = new ActiveXObject(""Scripting.Dictionary""); " & _
 " var keys = new Array(); for (var i in jsonObj) { dictionary.add(i,jsonObj[i]); }; return dictionary; } "
 soScriptEngine.AddCode "function setKeyValue(jsonObj, key, newItem) { jsonObj[key]=newItem; return jsonObj; }"
 soScriptEngine.AddCode "function toVBString(jsonObj) { return JSON.stringify(jsonObj); }"
 soScriptEngine.AddCode "function overrideToString(jsonObj) { jsonObj.toString = function() { return JSON.stringify(this); } }"
 End If
 Set GetScriptEngine = soScriptEngine
End Function
Private Function GetJavaScriptLibrary(ByVal sURL As String) As String
 Dim xHTTPRequest As MSXML2.XMLHTTP60
 Set xHTTPRequest = New MSXML2.XMLHTTP60
 xHTTPRequest.Open "GET", sURL, False
 xHTTPRequest.send
 GetJavaScriptLibrary = xHTTPRequest.responseText
End Function
Private Function DecodeJsonString(ByVal JsonString As String) As Object
 Dim oScriptEngine As ScriptControl
 Set oScriptEngine = GetScriptEngine
 Set DecodeJsonString = oScriptEngine.Eval("(" + JsonString + ")")
 Call oScriptEngine.Run("overrideToString", DecodeJsonString) '* this gives JSON rendering instead of "[object Object]"
End Function
Private Function GetJSONPrimitive(ByVal obj As Object, ByVal sKey As String, Optional vDefaultValue As Variant) As Variant
 Dim vRet As Variant
 If obj.hasOwnProperty(sKey) Then
 vRet = VBA.CallByName(obj, sKey, VbGet)
 Else
 vRet = vDefaultValue
 End If
 GetJSONPrimitive = vRet
End Function
Private Function GetJSONObject(ByVal obj As Object, ByVal sKey As String) As Object
 Dim objReturn As Object
 If obj.hasOwnProperty(sKey) Then
 Set objReturn = VBA.CallByName(obj, sKey, VbGet)
 Call GetScriptEngine.Run("overrideToString", objReturn) '* this gives JSON rendering instead of "[object Object]"
 End If
 Set GetJSONObject = objReturn
End Function
Private Function TestAll() As Boolean
 Debug.Assert TestPlaceDetails
 Debug.Assert TestNearbySearch
 Debug.Assert TestAutoComplete
 Debug.Assert BigTest
 Debug.Assert EvenBiggerTest
 Debug.Assert TestTextSearch 'biggest of all
 TestAll = True
End Function
Private Function BigTest() As Boolean
 Dim dicPlacesWithPlaceIds As Scripting.Dictionary
 Set dicPlacesWithPlaceIds = AutoComplete(sKey, "Sevenoaks")
 ReDim v(1 To dicPlacesWithPlaceIds.Count + 1, 1 To 2)
 v(1, 1) = "Place": v(1, 2) = "Lat, Long"
 Dim lLoop As Long
 For lLoop = 1 To dicPlacesWithPlaceIds.Count
 Dim sPlace As String
 sPlace = dicPlacesWithPlaceIds.Keys()(lLoop - 1)
 Dim sPlaceID As String
 sPlaceID = dicPlacesWithPlaceIds.Items()(lLoop - 1)
 Dim dicPlaceDetails As Scripting.Dictionary
 Set dicPlaceDetails = PlaceDetails(sKey, sPlaceID)
 v(lLoop + 1, 1) = sPlace
 v(lLoop + 1, 2) = dicPlaceDetails.Items()(0)
 Next
 'Stop
 ActiveSheet.Cells(1, 1).CurrentRegion.Clear
 ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(dicPlacesWithPlaceIds.Count + 1, 2)).Value2 = v
 BigTest = True
End Function
Private Function EvenBiggerTest() As Boolean
 Dim dicPlacesWithPlaceIds As Scripting.Dictionary
 Set dicPlacesWithPlaceIds = AutoComplete(sKey, "Hamburg")
 If dicPlacesWithPlaceIds.Count > 0 Then
 Dim sTopPrediction As String
 sTopPrediction = dicPlacesWithPlaceIds.Keys()(0)
 Dim sTopPredictionPlaceId As String
 sTopPredictionPlaceId = dicPlacesWithPlaceIds.Items()(0)
 Dim dicPlaceDetails As Scripting.Dictionary
 Set dicPlaceDetails = PlaceDetails(sKey, sTopPredictionPlaceId)
 Dim sTopPredictionLocation As String
 sTopPredictionLocation = dicPlaceDetails.Item("Location")
 Dim dicNearbySearchResults As Scripting.Dictionary
 Set dicNearbySearchResults = NearbySearch(sKey, sTopPredictionLocation, 100, "post office")
 ReDim v(1 To dicNearbySearchResults.Count + 1, 1 To 5)
 v(1, 1) = "Name": v(1, 2) = "PlaceId": v(1, 3) = "Address": v(1, 4) = "Vicinity": v(1, 5) = "Type0"
 Dim lLoop As Long
 For lLoop = 1 To dicNearbySearchResults.Count
 Dim sPlaceIdLoop As String
 sPlaceIdLoop = dicNearbySearchResults.Items()(lLoop - 1)
 Set dicPlaceDetails = PlaceDetails(sKey, sPlaceIdLoop)
 v(lLoop + 1, 1) = dicNearbySearchResults.Keys()(lLoop - 1)
 v(lLoop + 1, 2) = sPlaceIdLoop
 v(lLoop + 1, 3) = dicPlaceDetails.Item("Address")
 If dicPlaceDetails.Exists("Vicinity") Then
 v(lLoop + 1, 4) = dicPlaceDetails.Item("Vicinity")
 End If
 If dicPlaceDetails.Exists("Type0") Then
 v(lLoop + 1, 5) = dicPlaceDetails.Item("Type0")
 End If
 Next
 'Stop
 ActiveSheet.Cells(1, 1).CurrentRegion.Clear
 ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(dicNearbySearchResults.Count + 1, 5)).Value2 = v
 End If
 EvenBiggerTest = True
End Function
Private Function TextSearch(ByVal sAPIKey As String, ByVal sSearchQuery As String, ByRef pdicFieldOrinals As Scripting.Dictionary) As Scripting.Dictionary
 '
 'Tools->References->
 'Microsoft Scripting Runtime
 Dim dicTextSearchResults As Scripting.Dictionary
 Set dicTextSearchResults = New Scripting.Dictionary
 Set pdicFieldOrinals = New Scripting.Dictionary
 Dim psNextPageToken As String: psNextPageToken = ""
 Do
 If psNextPageToken <> "" Then
 Application.Wait (Now() + CDate("00:00:05"))
 End If
 Dim xHTTPRequest As MSXML2.XMLHTTP60
 Set xHTTPRequest = New MSXML2.XMLHTTP60
 Dim sURL As String
 sURL = "https://maps.googleapis.com/maps/api/place/textsearch/json?key=" & sAPIKey & "&query=" & sSearchQuery
 If psNextPageToken <> "" Then sURL = sURL & "&pagetoken=" & psNextPageToken
 xHTTPRequest.Open "GET", sURL
 xHTTPRequest.send
 While xHTTPRequest.readyState <> 4
 DoEvents
 Wend
 If Len(xHTTPRequest.responseText) > 0 Then
 'Debug.Print Left$(xHTTPRequest.responseText, 500)
 Dim objJSON As Object
 Set objJSON = DecodeJsonString(xHTTPRequest.responseText)
 ParseTextSearchResponse objJSON, dicTextSearchResults, pdicFieldOrinals, psNextPageToken
 End If
 Loop Until psNextPageToken = ""
 Set TextSearch = dicTextSearchResults
End Function
Private Function TestTextSearch() As Boolean
 ActiveSheet.Cells(1, 1).CurrentRegion.Clear
 Dim pdicFieldOrinals As Scripting.Dictionary
 Dim dicTextSearchResults As Scripting.Dictionary
 Set dicTextSearchResults = TextSearch(sKey, "london+restaurants", pdicFieldOrinals)
 Dim dicDetails As Scripting.Dictionary
 Set dicDetails = dicTextSearchResults.Item(dicTextSearchResults.Keys()(0))
 Dim vGrid As Variant
 vGrid = NestedDictionaryToGrid(dicTextSearchResults, pdicFieldOrinals)
 ActiveSheet.Cells(1, 1).CurrentRegion.Clear
 ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(dicTextSearchResults.Count + 1, pdicFieldOrinals.Count)).Value2 = vGrid
 TestTextSearch = True
End Function
Private Function ParseTextSearchResponse(ByVal objJSON As Object, _
 ByVal dicTextSearchResults As Scripting.Dictionary, ByVal dicFieldOrinals As Scripting.Dictionary, _
 ByRef psPageToken As String)
 If Not objJSON Is Nothing Then
 psPageToken = GetJSONPrimitive(objJSON, "next_page_token", "")
 Dim sStatus As String
 sStatus = GetJSONPrimitive(objJSON, "status")
 If sStatus = "OK" Then
 Dim objResults As Object
 Set objResults = GetJSONObject(objJSON, "results")
 Dim lLength As Long
 lLength = GetJSONPrimitive(objResults, "length", -1)
 Dim lLoop As Long
 For lLoop = 0 To lLength - 1
 Dim objResultLoop As Object
 Set objResultLoop = GetJSONObject(objResults, CStr(lLoop))
 Dim sName As String
 sName = GetJSONPrimitive(objResultLoop, "name")
 Dim dicKeys As Scripting.Dictionary
 Set dicKeys = GetScriptEngine.Run("getKeyValues", objResultLoop)
 Dim dicFlattenedDetails As Scripting.Dictionary
 Set dicFlattenedDetails = New Scripting.Dictionary
 Dim vKeyLoop As Variant
 For Each vKeyLoop In dicKeys.Keys
 If Not dicFieldOrinals.Exists(vKeyLoop) Then dicFieldOrinals.Add vKeyLoop, dicFieldOrinals.Count
 Dim vValue As Variant: vValue = Empty
 Select Case vKeyLoop
 Case "formatted_address", "icon", "id", "name", "permanently_closed", "place_id", "price_level", "rating", "reference":
 vValue = VBA.CallByName(objResultLoop, vKeyLoop, VbGet)
 dicFlattenedDetails.Add vKeyLoop, vValue
 Case "geometry":
 dicFlattenedDetails.Add "geometry", ExtractLatitudeAndLongitude(GetJSONObject(objResultLoop, "geometry"))
 Case "opening_hours":
 dicFlattenedDetails.Add "opening_hours", ExtractOpeningHours(GetJSONObject(objResultLoop, "opening_hours"))
 Case "types":
 dicFlattenedDetails.Add "types", ExtractTypes(GetJSONObject(objResultLoop, "types"))
 Case "photos":
 '* NOT YET IMPLEMENTED
 Case Else
 Stop
 End Select
 Next vKeyLoop
 Dim sPlaceID As String
 sPlaceID = VBA.CallByName(objResultLoop, "place_id", VbGet)
 dicTextSearchResults.Add sPlaceID, dicFlattenedDetails
 Next
 End If
 End If
End Function
Private Function ExtractOpeningHours(ByVal objOpeningHours As Object) As String
 Dim vOpenNow As Variant
 vOpenNow = VBA.CallByName(objOpeningHours, "open_now", VbGet)
 Dim bOpenNow As Boolean
 bOpenNow = CBool(vOpenNow)
 Dim objWeekdayText As Object
 Set objWeekdayText = GetJSONObject(objOpeningHours, "weekday_text")
 Dim lLength As Long
 lLength = VBA.CallByName(objWeekdayText, "length", VbGet)
 If lLength > 0 Then
 Dim dicWeekdaysKeys As Scripting.Dictionary
 Set dicWeekdaysKeys = GetScriptEngine.Run("getKeyValues", objWeekdayText)
 Stop
 End If
 ExtractOpeningHours = VBA.IIf(bOpenNow, "open", "closed")
End Function
Private Function ExtractTypes(ByVal objTypes As Object) As String
 Dim lLength As Long
 lLength = VBA.CallByName(objTypes, "length", VbGet)
 Dim dicTypes As Scripting.Dictionary
 Set dicTypes = New Scripting.Dictionary
 Dim lLoop As Long
 For lLoop = 0 To lLength - 1
 Dim sTypeLoop As String
 sTypeLoop = VBA.CallByName(objTypes, CStr(lLoop), VbGet)
 dicTypes.Add sTypeLoop, 0
 Next lLoop
 ExtractTypes = VBA.Join(dicTypes.Keys, "|")
End Function
Private Function TestNearbySearch() As Boolean
 Dim dicNearbySearchResults As Scripting.Dictionary
 Set dicNearbySearchResults = NearbySearch(sKey, sSEVENOAKS_LATITUDE_LONGITUDE, 500, "restaurant")
 Debug.Assert dicNearbySearchResults.Exists("Subway")
 Debug.Assert dicNearbySearchResults.Item("Subway") = "ChIJ_yoN0_tN30cRnjjjqftbnSw"
 TestNearbySearch = True
End Function
Public Function NearbySearch(ByVal sAPIKey As String, ByVal sLocationLatitudeLongitude As String, ByVal lRadius As Long, _
 ByVal sSearchType As String)
 '
 'Tools->References->
 'Microsoft Scripting Runtime
 Dim dicNearbySearchResults As Scripting.Dictionary
 Set dicNearbySearchResults = New Scripting.Dictionary
 Dim xHTTPRequest As MSXML2.XMLHTTP60
 Set xHTTPRequest = New MSXML2.XMLHTTP60
 xHTTPRequest.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/json?key=" & sAPIKey & "&location=" & sLocationLatitudeLongitude & "&radius=" & lRadius & "&type=" & sSearchType
 xHTTPRequest.send
 While xHTTPRequest.readyState <> 4
 DoEvents
 Wend
 If Len(xHTTPRequest.responseText) > 0 Then
 Dim objJSON As Object
 Set objJSON = DecodeJsonString(xHTTPRequest.responseText)
 If Not objJSON Is Nothing Then
 Dim sStatus As String
 sStatus = GetJSONPrimitive(objJSON, "status")
 If sStatus = "OK" Then
 Dim objResults As Object
 Set objResults = GetJSONObject(objJSON, "results")
 Dim lLength As Long
 lLength = VBA.CallByName(objResults, "length", VbGet)
 Dim lLoop As Long
 For lLoop = 0 To lLength - 1
 Dim objResultLoop As Object
 Set objResultLoop = GetJSONObject(objResults, CStr(lLoop))
 Dim sName As String
 sName = VBA.CallByName(objResultLoop, "name", VbGet)
 Dim sPlaceID As String
 sPlaceID = VBA.CallByName(objResultLoop, "place_id", VbGet)
 dicNearbySearchResults.Add sName, sPlaceID
 Next
 End If
 End If
 End If
 Set NearbySearch = dicNearbySearchResults
End Function
Private Function ExtractLatitudeAndLongitude(ByVal objGeometry As Object) As String
 Dim objLocation As Object
 Set objLocation = GetJSONObject(objGeometry, "location")
 Dim sLatitude As String
 sLatitude = VBA.CallByName(objLocation, "lat", VbGet)
 Dim sLongitude As String
 sLongitude = VBA.CallByName(objLocation, "lng", VbGet)
 ExtractLatitudeAndLongitude = sLatitude & "," & sLongitude
End Function
Private Function TestPlaceDetails() As Boolean
 Dim dicPlaceDetails As Scripting.Dictionary
 Set dicPlaceDetails = PlaceDetails(sKey, sSEVENOAKS_PLACEID)
 Debug.Assert dicPlaceDetails.Keys()(0) = "Location"
 Debug.Assert dicPlaceDetails.Items()(0) = "51.27241,0.190898"
 TestPlaceDetails = True
End Function
Public Function PlaceDetails(ByVal sAPIKey As String, ByVal sPlaceID As String) As Scripting.Dictionary
 'Tools->References->
 'Microsoft Scripting Runtime
 Dim dicPlaceDetails As Scripting.Dictionary
 Set dicPlaceDetails = New Scripting.Dictionary
 Dim xHTTPRequest As MSXML2.XMLHTTP60
 Set xHTTPRequest = New MSXML2.XMLHTTP60
 xHTTPRequest.Open "GET", "https://maps.googleapis.com/maps/api/place/details/json?key=" & sAPIKey & "&placeid=" & sPlaceID
 xHTTPRequest.send
 While xHTTPRequest.readyState <> 4
 DoEvents
 Wend
 If Len(xHTTPRequest.responseText) > 0 Then
 Dim objJSON As Object
 Set objJSON = DecodeJsonString(xHTTPRequest.responseText)
 If Not objJSON Is Nothing Then
 Dim objResult As Object
 Set objResult = GetJSONObject(objJSON, "result")
 If Not objResult Is Nothing Then
 'If objJSON.hasOwnProperty("result") Then
 Dim objGeometry As Object
 Set objGeometry = GetJSONObject(objResult, "geometry")
 If Not objResult Is Nothing Then
 Dim objLocation As Object
 Set objLocation = GetJSONObject(objGeometry, "location")
 If Not objLocation Is Nothing Then
 Dim sLatitude As String
 sLatitude = VBA.CallByName(objLocation, "lat", VbGet)
 Dim sLongitude As String
 sLongitude = VBA.CallByName(objLocation, "lng", VbGet)
 dicPlaceDetails.Add "Location", sLatitude & "," & sLongitude
 End If
 dicPlaceDetails.Add "Address", VBA.CallByName(objResult, "formatted_address", VbGet)
 dicPlaceDetails.Add "Name", VBA.CallByName(objResult, "name", VbGet)
 If objResult.hasOwnProperty("vicinity") Then
 dicPlaceDetails.Add "Vicinity", VBA.CallByName(objResult, "vicinity", VbGet)
 End If
 Dim objTypes As Object
 Set objTypes = GetJSONObject(objResult, "types")
 If Not objTypes Is Nothing Then
 Dim lTypesLength As Long
 lTypesLength = VBA.CallByName(objTypes, "length", VbGet)
 Dim sType0 As String
 sType0 = VBA.CallByName(objTypes, "0", VbGet)
 dicPlaceDetails.Add "Type0", sType0
 End If
 dicPlaceDetails.Add "PlaceId", sPlaceID
 End If
 End If
 End If
 End If
 Set PlaceDetails = dicPlaceDetails
End Function
Private Function TestAutoComplete() As Boolean
 Dim dicPlacesWithPlaceIds As Scripting.Dictionary
 Set dicPlacesWithPlaceIds = AutoComplete(sKey, "Sevenoaks")
 Debug.Assert dicPlacesWithPlaceIds.Keys()(0) = "Sevenoaks, United Kingdom"
 Debug.Assert dicPlacesWithPlaceIds.Items()(0) = sSEVENOAKS_PLACEID
 TestAutoComplete = True
End Function
Public Function AutoComplete(ByVal sAPIKey As String, ByVal sPlaceText As String) As Scripting.Dictionary
 'Tools->References->
 'Microsoft Scripting Runtime
 Dim dicPlacesWithPlaceIds As Scripting.Dictionary
 Set dicPlacesWithPlaceIds = New Scripting.Dictionary
 Dim xHTTPRequest As MSXML2.XMLHTTP60
 Set xHTTPRequest = New MSXML2.XMLHTTP60
 xHTTPRequest.Open "GET", "https://maps.googleapis.com/maps/api/place/autocomplete/json?key=" & sAPIKey & "&input=" & sPlaceText & "&sensor=false", False
 xHTTPRequest.send
 While xHTTPRequest.readyState <> 4
 DoEvents
 Wend
 If Len(xHTTPRequest.responseText) > 0 Then
 Dim objJSON As Object
 Set objJSON = DecodeJsonString(xHTTPRequest.responseText)
 If Not objJSON Is Nothing Then
 Dim objPredictions As Object
 Set objPredictions = GetJSONObject(objJSON, "predictions")
 If Not objPredictions Is Nothing Then
 Dim lLength As Long
 lLength = VBA.CallByName(objPredictions, "length", VbGet)
 Dim lLoop As Long
 For lLoop = 0 To lLength - 1
 Dim objPredictionLoop As Object
 Set objPredictionLoop = GetJSONObject(objPredictions, CStr(lLoop))
 Dim sPlaceDescription As String
 sPlaceDescription = VBA.CallByName(objPredictionLoop, "description", VbGet)
 Dim sPlaceID As String
 sPlaceID = VBA.CallByName(objPredictionLoop, "place_id", VbGet)
 dicPlacesWithPlaceIds.Add sPlaceDescription, sPlaceID
 'Stop
 Next
 'Stop
 End If
 End If
 'Stop
 End If
 Set AutoComplete = dicPlacesWithPlaceIds
 'Debug.Print xHTTPRequest.responseText
End Function
Private Function NestedDictionaryToGrid(ByVal dicData As Scripting.Dictionary, ByVal dicFieldOrdinals As Scripting.Dictionary) As Variant
 ReDim vRet(1 To dicData.Count + 1, 1 To dicFieldOrdinals.Count)
 Dim vFieldKeyLoop As Variant
 For Each vFieldKeyLoop In dicFieldOrdinals.Keys
 vRet(1, dicFieldOrdinals.Item(vFieldKeyLoop) + 1) = vFieldKeyLoop
 Next
 Dim lRowLoop As Long: lRowLoop = 1
 Dim vDataKeyLoop As Variant
 For Each vDataKeyLoop In dicData.Keys
 lRowLoop = lRowLoop + 1
 Dim dicDetails As Scripting.Dictionary
 Set dicDetails = dicData.Item(vDataKeyLoop)
 For Each vFieldKeyLoop In dicFieldOrdinals.Keys
 vRet(lRowLoop, dicFieldOrdinals.Item(vFieldKeyLoop) + 1) = dicDetails.Item(vFieldKeyLoop)
 Next
 Next vDataKeyLoop
 NestedDictionaryToGrid = vRet
End Function

• S Meaden: I no longer use Eval in my code, instead I use Douglas Crockford's library, for reasons see here exceldevelopmentplatform.blogspot.com/2018/01/…

Answer 1

I'll clear the easy stuff first, using Rubberduck 2.0b code inspections:

Language Opportunities

• Prefer vbNullString to "": The built-in constant vbNullString is a null string pointer taking up 0 bytes of memory, that unambiguously conveys the intent of an empty string.
• Use of the obsolete Call statement: The Call statement is no longer required to call procedures, and only exists in the language to support legacy code that did require it. It can be safely rewritten to the more modern implicit call form.

Maintainability and Readability Issues

• Consider renaming variable sType0: identifier names should indicate what they're used for and should be readable. Avoid numeric suffixes.

Code Quality Issues

• Constant sKEYNAME is not used. Consider removing it.
• Return value of function TestAll is never used. Consider making the function a Sub procedure instead.
• Return value of function ParseTextSearchResponse is never used. Consider making the function a Sub procedure instead.
• Return type of function ParseTextSearchResponse is implicitly Variant - apparently that function was actually meant to be a Sub.
• Return value of function ParseTextSearchResponse is never assigned. That's it, it's a Sub in a Function disguise!
• Parameter vDefaultValue (in GetJSONPrimitive) is implicitly passed by reference. Consider making it explicitly ByRef.
• Parameter vDefaultValue could be passed by value... unless it could be an array? This inspection result comes up because the parameter isn't assigned a new value in the function's body, but if an array is a valid value for it, then passing it ByVal would break the code. If an array isn't a valid value for it, then passing it ByVal would make the intent clearer.
• Return type of function NearbySearch is implicitly Variant. Yet you're assigning it a Scripting.Dictionary - why not specify the return type?
• Function TestAll is not used. And it's Private, too - which makes it essentially unreachable.
• Variable sTopPrediction is never used in EvenBiggerTest. It's assigned a value, but that value serves no apparent purpose.
• Variable dicDetails is never used in TestTextSearch. Again it's assigned, but nothing is done with the assigned value.
• Variable sName is never used in ParseTextSearchResponse. Assigned from a call to GetJSONPrimitive, and then nothing.
• Variable dicWeekdayKeys is never used in ExtractOpeningHours.
• Variable lTypesLength is not used either, in PlaceDetails.

Not bad at all, I've seen shorter code trigger more inspection results than that!

---

Hungarian Notation

Your naming style consistently (good!) uses a heavily discouraged (bad!) Hungarian Notation that encodes a variable's type into its identifier name, which hurts readability (lowercase "L" for "Long"? that's plain evil!) with zero benefits, especially since you're declaring variables as close as possible to their usage, so the variable's type is right there in your face anyway - kudos for avoiding the unfortunately too common "wall of declarations" trap!

The "right" way of using Hungarian Notation, is to add meaningful context - the name of the type of a variable isn't meaningful context. Read Making Wrong Code Look Wrong on Joel on Software for the whole argumentative and examples of "Hungarian Notation done right".

Applied to VBA, I like to use ByRef parameters to illustrate. Consider this signature:

Public Sub DoSomething(ByVal foo As Integer, ByRef bar As Integer)

Ignore the fact that bar could be the return value of a Function for a moment - this is just an example. What clue does the user of this procedure have that bar is really an out parameter? None. And we're lucky here, we have explicit ByVal and ByRef modifiers. Imagine this signature for a procedure that does exactly the same thing:

Public Sub DoSomething(foo As Integer, bar As Integer)

Ew. Now consider this:

Public Sub DoSomething(foo As Integer, outBar As Integer)

Oh. An out prefix tells us that the second parameter is actually a return value! That is a useful prefix. Compare to:

Public Sub DoSomething(iFoo As Integer, iBar As Integer)

The i-for-Integer prefix is totally redundant and useless.

---

GetScriptEngine calls AddCode 5 times, but once would be enough:

Private Function GetScriptEngine() As ScriptControl
 Static scriptEngine As ScriptControl
 Static script As String
 
 If scriptEngine Is Nothing Then
 
 script = GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js") & _
 "function getKeyValues(jsonObj) { " & _
 " var dictionary = new ActiveXObject(""Scripting.Dictionary""); " & _
 " var keys = new Array(); for (var i in jsonObj) { dictionary.add(i,jsonObj[i]); }; return dictionary; } " & _
 "function setKeyValue(jsonObj, key, newItem) { jsonObj[key]=newItem; return jsonObj; }" & _
 "function toVBString(jsonObj) { return JSON.stringify(jsonObj); }" & _
 "function overrideToString(jsonObj) { jsonObj.toString = function() { return JSON.stringify(this); } }"
 
 Set scriptEngine = New ScriptControl
 scriptEngine.Language = "JScript"
 scriptEngine.AddCode script
 End If
 
 Set GetScriptEngine = scriptEngine
 
End Function

I have to say I'm ambivalent about Static locals: they have that funky smell - a Static local could very often just as well be declared at module scope... but then if they're only ever used in one place, what's the point, right?

I think your module is doing too many things, and that you need more objects in your life. Class modules. I'd move that to a ScriptEngine class, have the script live there, encapsulated, and holding on to its ScriptControl instance, perhaps even encapsulate that as well, and only expose methods that the client code needs to see.

Ignoring the assignment of the function's return value, it's only used in 4 places:

all references to 'GetScriptEngine' - Rubberduck "search results" docked toolwindow

The members used are Run and Eval - so yeah, I'd encapsulate it and expose a Run and an Eval method for the client code to consume, instead of relying on Static locals and procedural code.

---

Here's another example of poor naming:

Dim vKeyLoop As Variant
For Each vKeyLoop In dicKeys.Keys

vKeyLoop tells you it's a dictionary key... and that it's used in a loop. Oh and that it's a Variant.. If you're going to iterate strings in a For Each loop, it needs to be a Variant - so again the Hungarian prefix serves no purpose at all. But that's not why it's a bad name: the real question is, what does the darn key represent? THAT is what, as a maintainer of that code base, I'd like to be able to infer from the variable's name. I know it's a key because I'm iterating keys. I know it's a loop variable because, well, it's a For Each loop variable anyway. And I know it's a Variant because it has to be a Variant for the For Each loop to even compile.

---

Speaking of compiling... sKey isn't declared in BigTest, which, because of Option Explicit, makes the code uncompilable. Ditto in EvenBiggerTest, and TestTextSearch as well.

---

Speaking of testing... The test code should really be separate from the code it's testing. Pull these methods into their own module, it's urgent!

The tests themselves aren't clear about what the expectations are; they merely output stuff, but we don't know if it's right or if it's wrong until we visually inspect the ActiveSheet and interpret the results.

If you could break the coupling with the web API, extract the functionality into a class that only exposes it (the functionality) via an interface, then you could implement a mock version of that interface and write (and run!) actual unit tests, which would test all the functionality without ever hitting the web (i.e. they would run in a few milliseconds), and you would have an immediate feedback about exactly which part of the spec you broke with your latest modification - if that sounds interesting, I suggest you take a look at the features page of Rubberduck's website.

Disclaimer: I'm totally, completely, heavily involved with the Rubberduck project.

• S Meaden: Ok thanks a thorough examination. I could make rebuttals on many points but it is probably better to move to a meta discussion about code police. Just a few rebuttals though, the stack overflow (SO) original poster (OP) had his own API key, so sKey was commented out but actually public in another module (not shown) so as not to expose my API key. Also, I know tests should be in separate modules but I was giving OP a slab of code that they could cut and paste.
• S Meaden: On the meta level is Rubberduck like MZTools which also highlighted unused variables etc. It sounds like a 'code police' tool which I have had whilst working on very many large systems with millions of lines of code; are the rules configurable?
• S Meaden: Do you have any endorsements from people like Steve Bullen (author of Processional Excel Development)? He was a mentor of mine when I worked alongside him for two years.
• Mathieu Guindon: Not sure it counts as "endorsement", but Mr.Bullen has offered the original VB6 Smart Indenter code to the project; Carlos J.Quintero (author of MZ-Tools) came to our chatroom to congratulate us, and a bunch of MVP's are following us on GitHub and Twitter.
• Mathieu Guindon: @SMeaden join vba rubberducking chat anytime you want to talk about it! =)