Google Places Details to VBA的Excel [英] Google Places Details to Excel with VBA

查看：67 发布时间：2021/5/12 20:43:43 vba excel api google-places-api

本文介绍了Google Places Details to VBA的Excel的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正尝试通过使用对Google的文本搜索请求将Google地方的完整详细信息列表获取到Excel工作表中.

I'm trying to get a full detail list of Google places to an Excel sheet by using a Text Search request to Google.

所以我想通过

将搜索字符串写入Excel单元格

writing a search string to an Excel cell

让VBA查询Google"地点搜索"并返回与搜索字符串匹配的Placeid的临时列表

getting the VBA to query Google "Place Search" and returning a temporary list of Placeid's matching the search string

让VBA通过Google"

getting the VBA to query all the details of the previous step's Placeid's with Google "Place Details" and writing them to the sheet

据我所知，代码应将这两个API链接".我已经有一个适用于Google的API密钥.

So the code should "chain" these two APIs to my understanding. I have an API key already for Google.

推荐答案

好，因此，一些初始工作请参见(BigTest()和EvenBiggerTest())，请参阅先前的编辑内容，但在重新阅读您的评论后，我可以看到您想要的TextSearch.请参阅请运行TestTestSearch()

Ok, so some initial work see (BigTest() and EvenBiggerTest()) see remains from prior edit but after re-reading your comments I can see you wanted TextSearch. See please run TestTestSearch()

我使它具有多页意识，因为Google一次返回20行，如果还有更多，则返回下一页令牌.因此，提供下一页令牌即可获得下一页.这无法正常工作，我也不知道为什么，因为伦敦的餐馆数量最多不超过60家.

I have made it multipage aware in that Google returns 20 rows at a time plus a next page token if there is some more; so one supply the next page token to get the next page. This is not working reliably and I do not know why, for London restaurants never more than 60.

随意浏览代码，我做了很多临时变量，您可以在Locals Window中观察这些变量，以查看JSON结构.

Feel free to step through the code, I have made plenty of interim variable which you can observe in the Locals Window to see the JSON structure.

有一些很好的VBA.CallbyName逻辑，很少有人知道有关查询JSON结构的信息(我在韩国网站上找到了它).渴望将其发布到Stackoverflow.

There is some nice VBA.CallbyName logic which few people know about regarding interrogating a JSON structure (I found it on Korean website). Itching to post it on Stackoverflow.

您需要添加以下项目引用，它们会导入库

You'll need to add the following project references, they import libraries

'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

Public Const sKEYNAME As String = "Server key 1"

'Public Const sKEY As String = "Your key goes here and uncomment"

Public Const sSEVENOAKS_PLACEID As String = "ChIJwd9bXUyt2EcRYv6GY0JRnCw"   'Place ID: ChIJwd9bXUyt2EcRYv6GY0JRnCw Sevenoaks , Sevenoaks, Kent, UK


Public Const sSEVENOAKS_LATITUDE_LONGITUDE As String = "51.2724,0.1909"    '51.2724° N, 0.1909° E




Private Sub BigTest()

    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
End Sub


Private Sub EvenBiggerTest()

    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"

                        'dicPlaceDetails.Add "Location", sLatitude & "," & sLongitude

                        'dicPlaceDetails.Add "Address", VBA.CallByName(objResult, "formatted_address", VbGet)
                        'dicPlaceDetails.Add "Name", VBA.CallByName(objResult, "name", VbGet)
                        'dicPlaceDetails.Add "Vicinity", VBA.CallByName(objResult, "vicinity", VbGet)
                        'dicPlaceDetails.Add "PlaceId", sPlaceID


        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

            'dicNearbySearchResults.Items()(lLoop - 1)

        Next

        'Stop
        ActiveSheet.Cells(1, 1).CurrentRegion.Clear
        ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(dicNearbySearchResults.Count + 1, 5)).Value2 = v
    End If
End Sub


Private Sub TestAutoComplete()

   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
End Sub


Private Sub TestNearbySearch()

   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"

    Stop
End Sub

Private Sub TestPlaceDetails()

   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"
End Sub

Private Sub TestTextSearch()

    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

    'd'ebug.Print dicDetails.Item("lat,lng")
    'Debug.Print dicDetails.Item("types")
    'Stop
    'Debug.Assert dicTextSearchResults.Exists("Subway")
    'Debug.Assert dicTextSearchResults.Item("Subway") = "ChIJ_yoN0_tN30cRnjjjqftbnSw"

    'Stop
End Sub

Public Function CreateScriptControl() As ScriptControl

    Static oScriptEngine As ScriptControl
    If oScriptEngine Is Nothing Then
        Set oScriptEngine = New ScriptControl
        oScriptEngine.Language = "JScript"
        oScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
    End If

    Set CreateScriptControl = oScriptEngine

End Function

Public 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 = ""

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = CreateScriptControl

    Do
        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 = oScriptEngine.Eval("(" + xHTTPRequest.responseText + ")")

            ParseTextSearchResponse oScriptEngine, objJSON, dicTextSearchResults, pdicFieldOrinals, psNextPageToken
        End If
    Loop Until psNextPageToken = ""
    Set TextSearch = dicTextSearchResults

End Function

Public Function ParseTextSearchResponse(ByVal oScriptEngine As ScriptControl, ByVal objJSON As Object, _
                ByVal dicTextSearchResults As Scripting.Dictionary, ByVal dicFieldOrinals As Scripting.Dictionary, _
                ByRef psPageToken As String)

    If Not objJSON Is Nothing Then

        Dim dicTopKeys As Scripting.Dictionary
        Set dicTopKeys = GetKeys(oScriptEngine, objJSON)


        If dicTopKeys.Exists("next_page_token") Then
            psPageToken = VBA.CallByName(objJSON, "next_page_token", VbGet)
        Else
            psPageToken = ""
        End If


        If dicTopKeys.Exists("status") Then

            Dim sStatus As String
            sStatus = VBA.CallByName(objJSON, "status", VbGet)

            If sStatus = "OK" Then

                Dim objResults As Object
                Set objResults = VBA.CallByName(objJSON, "results", VbGet)

                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 = VBA.CallByName(objResults, CStr(lLoop), VbGet)

                    Dim sName As String
                    sName = VBA.CallByName(objResultLoop, "name", VbGet)

                    Dim dicKeys As Scripting.Dictionary
                    Set dicKeys = GetKeys(oScriptEngine, 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(VBA.CallByName(objResultLoop, "geometry", VbGet))
                        Case "opening_hours":
                            dicFlattenedDetails.Add "opening_hours", ExtractOpeningHours(oScriptEngine, VBA.CallByName(objResultLoop, "opening_hours", VbGet))
                        Case "types":
                            dicFlattenedDetails.Add "types", ExtractTypes(VBA.CallByName(objResultLoop, "types", VbGet))
                        Case "photos":
                            '* NOT YET IMPLEMENTED
                        Case Else
                            Stop
                        End Select


                    Next vKeyLoop


                    Dim sPlaceID As String
                    sPlaceID = VBA.CallByName(objResultLoop, "place_id", VbGet)

                    Dim sVicinity As String
                    'sVicinity = VBA.CallByName(objResultLoop, "vicinity", VbGet)

                    dicTextSearchResults.Add sPlaceID, dicFlattenedDetails

                Next
            End If
        End If
    End If



End Function

Public Function ExtractOpeningHours(ByVal oScriptEngine As ScriptControl, 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 = VBA.CallByName(objOpeningHours, "weekday_text", VbGet)

    Dim lLength As Long
    lLength = VBA.CallByName(objWeekdayText, "length", VbGet)

    If lLength > 0 Then
        Dim dicWeekdaysKeys As Scripting.Dictionary
        Set dicWeekdaysKeys = GetKeys(oScriptEngine, objWeekdayText)


    End If

    ExtractOpeningHours = VBA.IIf(bOpenNow, "open", "closed")

End Function

Public 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


Public Function GetKeys(ByVal oScriptEngine As ScriptControl, ByVal JsonObject As Object) As Scripting.Dictionary

    Dim dicReturn As Scripting.Dictionary
    Set dicReturn = New Scripting.Dictionary

    Dim objKeysObject As Object
    Set objKeysObject = oScriptEngine.Run("getKeys", JsonObject)

    Dim lLength As Long
    lLength = VBA.CallByName(objKeysObject, "length", VbGet)
    Dim lLoop As Long
    For lLoop = 0 To lLength - 1

        Dim vKeyLoop As Variant
        vKeyLoop = VBA.CallByName(objKeysObject, CStr(lLoop), VbGet)

        Debug.Assert Not dicReturn.Exists(vKeyLoop)
        dicReturn.Add vKeyLoop, 0

    Next lLoop

    Set GetKeys = dicReturn
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
        'Debug.Print xHTTPRequest.responseText
        Dim oScriptEngine As ScriptControl
        Set oScriptEngine = New ScriptControl
        oScriptEngine.Language = "JScript"

        Dim objJSON As Object
        Set objJSON = oScriptEngine.Eval("(" + xHTTPRequest.responseText + ")")

        If Not objJSON Is Nothing Then

            If TypeName(CallByName(objJSON, "status", VbGet)) <> "Nothing" Then

                Dim sStatus As String
                sStatus = VBA.CallByName(objJSON, "status", VbGet)

                If sStatus = "OK" Then

                    Dim objResults As Object
                    Set objResults = VBA.CallByName(objJSON, "results", VbGet)

                    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 = VBA.CallByName(objResults, CStr(lLoop), VbGet)

                        Dim sName As String
                        sName = VBA.CallByName(objResultLoop, "name", VbGet)

                        Dim sPlaceID As String
                        sPlaceID = VBA.CallByName(objResultLoop, "place_id", VbGet)

                        Dim sVicinity As String
                        'sVicinity = VBA.CallByName(objResultLoop, "vicinity", VbGet)

                        dicNearbySearchResults.Add sName, sPlaceID

                    Next
                End If
            End If
        End If
    End If
    Set NearbySearch = dicNearbySearchResults

End Function



Public Function ExtractLatitudeAndLongitude(ByVal objGeometry As Object) As String

    Dim objLocation As Object
    Set objLocation = VBA.CallByName(objGeometry, "location", VbGet)

    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


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 oScriptEngine As ScriptControl
        Set oScriptEngine = New ScriptControl
        oScriptEngine.Language = "JScript"

        Dim objJSON As Object
        Set objJSON = oScriptEngine.Eval("(" + xHTTPRequest.responseText + ")")

        If Not objJSON Is Nothing Then

            If TypeName(CallByName(objJSON, "result", VbGet)) <> "Nothing" Then

                Dim objResult As Object
                Set objResult = VBA.CallByName(objJSON, "result", VbGet)

                If TypeName(CallByName(objResult, "geometry", VbGet)) <> "Nothing" Then
                    Dim objGeometry As Object
                    Set objGeometry = VBA.CallByName(objResult, "geometry", VbGet)

                    If TypeName(CallByName(objGeometry, "location", VbGet)) <> "Nothing" Then
                        Dim objLocation As Object
                        Set objLocation = VBA.CallByName(objGeometry, "location", VbGet)

                        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

                        dicPlaceDetails.Add "Address", VBA.CallByName(objResult, "formatted_address", VbGet)

                        dicPlaceDetails.Add "Name", VBA.CallByName(objResult, "name", VbGet)

                        If JSONKeyExists(objResult, "vicinity", False) Then
                            dicPlaceDetails.Add "Vicinity", VBA.CallByName(objResult, "vicinity", VbGet)
                        End If

                        If JSONKeyExists(objResult, "types", True) Then
                            Dim objTypes As Object
                            Set objTypes = VBA.CallByName(objResult, "types", VbGet)

                            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
    End If
    Set PlaceDetails = dicPlaceDetails
End Function

Private Function JSONKeyExists(ByRef objJSON As Object, ByVal sKey As String, ByVal bIsObject As Boolean)
    On Error GoTo ErrHandler

    If bIsObject Then
        Dim obj As Object
        Set obj = VBA.CallByName(objJSON, sKey, VbGet)  'If error this jumps to error handler
    Else
        Dim vValue As Variant
        vValue = VBA.CallByName(objJSON, sKey, VbGet)  'If error this jumps to error handler
    End If
    JSONKeyExists = True
    Exit Function
ErrHandler:
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 oScriptEngine As ScriptControl
        Set oScriptEngine = New ScriptControl
        oScriptEngine.Language = "JScript"

        Dim objJSON As Object
        Set objJSON = oScriptEngine.Eval("(" + xHTTPRequest.responseText + ")")

        If Not objJSON Is Nothing Then

            If TypeName(CallByName(objJSON, "predictions", VbGet)) <> "Nothing" Then

                Dim objPredictions As Object
                Set objPredictions = VBA.CallByName(objJSON, "predictions", VbGet)

                Dim lLength As Long
                'lLength = ScriptEngine.Run("getProperty", objPredictions, "length")
                lLength = VBA.CallByName(objPredictions, "length", VbGet)

                Dim lLoop As Long
                For lLoop = 0 To lLength - 1

                    Dim objPredictionLoop As Object
                    Set objPredictionLoop = VBA.CallByName(objPredictions, CStr(lLoop), VbGet)


                    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

Public 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

这篇关于Google Places Details to VBA的Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文

Google Places Details to VBA的Excel [英] Google Places Details to Excel with VBA

问题描述

推荐答案

相关文章

其他开发最新文章

热门教程

热门工具

登录关闭

Google Places Details to VBA的Excel [英] Google Places Details to Excel with VBA

问题描述

推荐答案

相关文章

其他开发最新文章

热门教程

热门工具

登录 关闭

登录关闭