JSON (JavaScript Object Notation) na usługach Excela   strona główna:
A po co ten Excel ;-)
 
 
JSON, jak możemy doczytać np. w Wikipedii to "format wymiany danych komputerowych", ktoś więc musi te dane posiadać i na  
żądanie nam przesyłać. Dziś wykorzystanie obiektu JSON na potrzeby określania danych które zwraca Google Maps API Web Serv.   wikipedia JSON
a jakie to dane??  
Directions API   Google Maps API Web Services
Distance Matrix API  
Elevation API  
Geocoding API  
Time Zone API  
Places API  
przykłady którymi się zajmiemy to: Directions API, Distance Matrix API, Geocoding API ale po lekturze wykorzystanie pozostałych  
nie powinno stanowić problemu dla użytkownika chcącego z nich skorzystać :-)  
 
Geocoding API  
 
Function GeoCode(ByVal address As String) As String  
    Dim msXML As Object  
    Dim strURL As String  
'--------------The Google Geocoding API---------------------  
'https://developers.google.com/maps/documentation/geocoding/   The Google Geocoding API
 
'----------------JSON Output Formats------------------------  
'http://maps.googleapis.com/maps/api/geocode/json? _  
    address=1600+Amphitheatre+Parkway,+Mountain+View,+CA& _  
    sensor=true_or_false  
      
    strURL = "http://maps.googleapis.com/maps/api/geocode/json?" & _  
             "address=" & Encode(address) & _  
             "&language=pl-PL" & _  
             "&sensor=true"  
 
    'ThisWorkbook.FollowHyperlink strURL  
                      
    Set msXML = CreateObject("Microsoft.XMLHTTP")  
    With msXML  
        .Open "GET", strURL, False  
        .send  
        GeoCode = Replace_RegExp(.responseText, "\s|\xA0")  
    End With  
    Set msXML = Nothing  
End Function  
 
Treść zapytania i jego parametry są podane na stronie Google z dokumentacją. Parametry które można wykorzystać to:  
Wymagalne: address (lub latlng lub components) i sensor  
Opcjonalne: bounds, language, region, components  
Oprócz wymagalnych podałem właśnie language żeby zwracane wyniki były po polsku. Jakie to wyniki ?   
 
{  
   "results" : [  
      {  
         "address_components" : [  
            {
 
               "long_name" : "1",  
               "short_name" : "1",  
               "types" : [ "street_number" ]  
            },  
            {  
               "long_name" : "Środkowa",  
               "short_name" : "Środkowa",  
               "types" : [ "route" ]  
            },  
            {  
               "long_name" : "Białka Tatrzańska",  
               "short_name" : "Białka Tatrzańska",  
               "types" : [ "locality", "political" ]  
            },  
            {
 
               "long_name" : "Bukowina Tatrzańska",  
               "short_name" : "Bukowina Tatrzańska",  
               "types" : [ "administrative_area_level_3", "political" ]  
            },  
            {  
               "long_name" : "tatrzański",  
               "short_name" : "tatrzański",  
               "types" : [ "administrative_area_level_2", "political" ]  
            },  
            {  
               "long_name" : "Województwo małopolskie",  
               "short_name" : "Województwo małopolskie",  
               "types" : [ "administrative_area_level_1", "political" ]  
            },  
            {  
               "long_name" : "Polska",  
               "short_name" : "PL",  
               "types" : [ "country", "political" ]  
            },  
            {  
               "long_name" : "34-405",  
               "short_name" : "34-405",  
               "types" : [ "postal_code" ]  
            }  
         ],  
         "formatted_address" : "Środkowa 1, 34-405 Białka Tatrzańska, Polska",  
         "geometry" : {
 
            "location" : {  
               "lat" : 49.3740961,  
               "lng" : 20.1128285  
            },  
            "location_type" : "ROOFTOP",  
            "viewport" : {  
               "northeast" : {  
                  "lat" : 49.37544508029151,  
                  "lng" : 20.1141774802915  
               },  
               "southwest" : {  
                  "lat" : 49.37274711970851,  
                  "lng" : 20.1114795197085  
               }  
            }  
         },  
         "types" : [ "street_address" ]  
      }  
   ],  
   "status" : "OK"  
}  
 
 
Niepozorna funkcyjka a ma możliwości ;-)  
O ich wydobyciu.. później..  
 
 
Distance Matrix API  
 
Function DistanceMatrix(ParamArray adresy() As Variant) As String  
    Dim msXML As Object  
    Dim strURL As String  
'--------------The Google Distance Matrix API--------------------   The Google Distance Matrix API
'https://developers.google.com/maps/documentation/distancematrix/  
 
'----------------------JSON Output-------------------------------  
'http://maps.googleapis.com/maps/api/distancematrix/json? _  
    origins=Bia%C5%82ka%20Tatrza%C5%84ska& _  
    destinations=Nowy%20Targ|Zakopane|Czarny%20Dunajec& _  
    mode=driving& _  
    language=pl-PL& _  
    sensor=false  
 
    Dim i As Integer, strDestinations As String  
    For i = 1 To UBound(adresy)  
        strDestinations = strDestinations & Encode(adresy(i)) & "|"  
    Next  
    strDestinations = Left(strDestinations, Len(strDestinations) - 1)  
          
    strURL = "http://maps.googleapis.com/maps/api/distancematrix/json?" & _  
             "origins=" & Encode(adresy(0)) & "&" & _  
             "destinations=" & strDestinations & "&" & _  
             "mode=driving" & "&" & _  
             "language=pl-PL" & "&" & _  
             "sensor=false"  
      
    'ThisWorkbook.FollowHyperlink strURL  
      
    Set msXML = CreateObject("Microsoft.XMLHTTP")  
    With msXML  
        .Open "GET", strURL, False  
        .send  
        DistanceMatrix = Replace_RegExp(.responseText, "\s|\xA0")  
    End With  
    Set msXML = Nothing  
 
End Function  
 
Na stronie z dokumentacją są zarówno parametry zapytania jak i przykładowa treść. Jakie dane zwraca taka funkcja?  
 
strJsonRequest = modJSON.DistanceMatrix("Środkowa 1, Białka Tatrzańska", _  
                                            "Podhalańska 1, Nowy Targ", _  
                                            "Zakopane", "Czarny Dunajec")  
 
{
 
   "destination_addresses" : [  
      "Podhalańska 1, Nowy Targ, Polska",  
      "Zakopane, Polska",  
      "Czarny Dunajec, Polska"
 
   ],  
   "origin_addresses" : [ "Środkowa 1, 34-405 Białka Tatrzańska, Polska" ],  
   "rows" : [  
      {  
         "elements" : [  
            {
 
               "distance" : {  
                  "text" : "14,8 km",  
                  "value" : 14844  
               },  
               "duration" : {  
                  "text" : "17 min",  
                  "value" : 1008  
               },  
               "status" : "OK"  
            },  
            {  
               "distance" : {  
                  "text" : "19,9 km",  
                  "value" : 19948  
               },  
               "duration" : {  
                  "text" : "27 min",  
                  "value" : 1600  
               },  
               "status" : "OK"  
            },  
            {  
               "distance" : {  
                  "text" : "28,6 km",  
                  "value" : 28644  
               },  
               "duration" : {  
                  "text" : "31 min",  
                  "value" : 1848  
               },  
               "status" : "OK"  
            }  
         ]  
      }  
   ],  
   "status" : "OK"  
}  
 
Directions API  
 
Function Directions(adresZ As String, adresDo As String, ParamArray przez() As Variant) As String  
    Dim msXML As Object  
    Dim strURL As String  
'------------------The Google Directions API--------------------  
'https://developers.google.com/maps/documentation/directions/
  The Google Directions API
 
'-----------------------JSON Output-----------------------------  
'http://maps.googleapis.com/maps/api/directions/json? _  
    origin=Bia%C5%82ka%20Tatrza%C5%84ska& _  
    destination=CZarny%20Dunajec& _  
    waypoints=Nowy%20Targ|Zakopane& _  
    sensor=false  
      
    Dim i As Integer, strWayPoints As String  
    For i = 0 To UBound(przez)  
        strWayPoints = strWayPoints & Encode(przez(i)) & "|"  
    Next  
    strWayPoints = Left(strWayPoints, Len(strWayPoints) - 1)  
          
      
    strURL = "http://maps.googleapis.com/maps/api/directions/json?" & _  
             "origins=" & Encode(adresZ) & "&" & _  
             "destinations=" & Encode(adresDo) & "&" & _  
             "waypoints=" & strWayPoints & "&" & _  
             "sensor=false"  
 
    'ThisWorkbook.FollowHyperlink strURL  
 
    Set msXML = CreateObject("Microsoft.XMLHTTP")  
    With msXML  
        .Open "GET", strURL, False  
        .send  
        Directions = Replace_RegExp(.responseText, "\s|\xA0")  
    End With  
    Set msXML = Nothing  
 
End Function  
 
Zwraca trasę z punktu adresZ do punktu adresDo przez punkty pośrednie ParamArray przez()   
To informacje zwracane przez Google Maps w szczegółach trasy -->>  
 
 
To co umyslnie omijam to dwie funkcje:  
 
Function Replace_RegExp(vText As Variant, _   Funkcje Użytkownika oparte o Wyrażenia Regularne
                        strFind As String, _  
                        Optional vReplace As Variant = vbNullString) As Variant  
      
    On Error GoTo Replace_RegExp_Error  
      
    Dim objRegExp As Object 'VBScript.RegExp  
                                                  
    Set objRegExp = VBA.CreateObject("VBScript.RegExp")  
    With objRegExp  
        .Global = True  
        .Pattern = strFind  
        Replace_RegExp = .Replace(sourceString:=vText, _  
                                  replaceVar:=vReplace)  
 
    End With  
      
Replace_RegExp_Exit:  
    Set objRegExp = Nothing  
    Exit Function  
      
Replace_RegExp_Error:  
    Replace_RegExp = vText  
    Resume Replace_RegExp_Exit  
      
End Function  
 
wywołuję ją w w.w funkcjach przez np.:  
 
        Directions = Replace_RegExp(.responseText, "\s|\xA0")  
 
pattern określony jako "\s|\xA0" to "białe znaki" wszystkie: znaki podziału tekstu, entery, taby, spacje,… tym zapisem się ich  
pozbywam. Łatwiej wg mnie wygrzebywać istotne sprawy z ciągu pozbawionego tych fragmentów.  
 
Druga funkcja to:  
 
Function Encode(ByVal strText As String) As String  
    Dim objScrContr As Object  
    '------------Percent-encoding---------------  
    'http://en.wikipedia.org/wiki/URL_encoding   Percent-encoding
                      
    'JavaScript encodeURIComponent() Function  
    'http://www.w3schools.com/jsref/jsref_encodeuricomponent.asp   JavaScript encodeURIComponent() Function
                      
    Set objScrContr = VBA.CreateObject("MSScriptControl.ScriptControl")  
    With objScrContr  
        .Language = "JavaScript"  
        .AddCode "function encode(str) {" & _  
                    "return encodeURIComponent(str);" & _  
                 "}"  
        Encode = .Run("encode", strText)  
    End With  
    Set objScrContr = Nothing  
End Function  
 
Jeszcze w poprzednim temacie używałem funkcji GoogleAddress do kodowania "polskich znaków" na kody znaków. W większości   
przypadków wystarczało podmienić te.. na takie ..:  
 
    arrPL = VBA.Array(" ", "Ł", "ł", "ń", "ó", _  
                           "ź", "ę", "ą", "ż", _  
                           "Ż", "Ś", "ś")  
                                  
    arrRepl = VBA.Array("%20", "%C5%81", "%C5%82", "%C5%84", "%C3%B3", _  
                               "%C5%BA", "%C4%99", "%C4%85", "%C5%BC", _  
                               "%C5%BB", "%C5%9A", "%C5%9B")  
 
w końcu znalazłem zasadę ich tworzenia a wraz z nią sposób na automatyczne zmienianie fragmentów z poza zakresu [0-9a-Z] na  
odpowiednie kody. Co prawda łatwy sposób jest związany z JavaScript (funkcja encodeURIComponent) ale i to nas nie powstrzyma  
 :-)
   
   
Ww funkcje złączyłem w jeden moduł który można pobrać obok:   modJSON.bas
po imporcie tego modułu (lub powyższych funkcji) można np.:    
   
 
Function InfoAdministracyjne()  
    Dim strJsonRequest As String  
    Dim vArr As Variant  
      
    strJsonRequest = modJSON.GeoCode("Środkowa 1, Białka Tatrzańska")  
                                              
    vArr = Fragment_RegExp(strJsonRequest, "long_name.*?\}")  
    Stop  
End Function  
 
Function Lokalizacja()
 
    Dim strJsonRequest As String  
    Dim vArr As Variant  
      
    strJsonRequest = modJSON.GeoCode("Środkowa 1, Białka Tatrzańska")  
                                              
    vArr = Fragment_RegExp(strJsonRequest, "geometry.*?\}")  
    Stop  
End Function  
 
Function Odległość() As String
 
    Dim strJsonRequest As String  
    Dim vArr As Variant  
      
    strJsonRequest = modJSON.DistanceMatrix("Środkowa 1, Białka Tatrzańska", _  
                                            "Podhalańska 1, Nowy Targ", _  
                                            "Zakopane", "Czarny Dunajec")  
                                              
    vArr = Fragment_RegExp(strJsonRequest, "distance.*?\}")  
    Stop  
End Function  
 
Function Czas() As String
 
    Dim strJsonRequest As String  
    Dim vArr As Variant  
      
    strJsonRequest = modJSON.DistanceMatrix("Środkowa 1, Białka Tatrzańska", _  
                                            "Podhalańska 1, Nowy Targ", _  
                                            "Zakopane", "Czarny Dunajec")  
                                              
    vArr = Fragment_RegExp(strJsonRequest, "duration.*?\}")  
    Stop  
End Function  
 
Function Fragment_RegExp(vText As Variant, strPattern As String) As Variant  
    On Error GoTo Fragment_RegExp_Error  
    Dim objRegExp As Object 'VBScript.RegExp  
    Dim colMatches As Object, objMatch As Object  
    Dim tbl() As String, i As Integer: i = 1  
                
    Set objRegExp = VBA.CreateObject("VBScript.RegExp")  
    With objRegExp  
        .Global = True  
        .Pattern = strPattern  
        Set colMatches = objRegExp.Execute(vText)  
    End With  
      
    ReDim tbl(1 To colMatches.Count)  
    For Each objMatch In colMatches  
        tbl(i) = objMatch.Value: i = i + 1  
    Next  
      
    Fragment_RegExp = tbl()  
 
Fragment_RegExp_Error:  
    Set objMatch = Nothing  
    Set colMatches = Nothing  
    Set objRegExp = Nothing  
End Function  
 
i choć te wyniki są obiecujące i zatrzymują się w 99% drogi do celu. To na tym pozostanę :-P bo nie o tym miałem pisać.  
Ale pewnie każdy już teraz by sobie poradził :-)  
Efektem całego działania jest moduł modJSON.bas (link wyżej) a jeżeli będę korzystał z funkcji w nim zawartych żeby zwrócić jakieś  
potrzebne mi dane - tak jak w przykładach wyżej, to go wykorzystam.  
 
jeszcze tylko słowo dla ciekawych czemu ten "?" w pattern (np.: "duration.*?\}")  
polecam pogrzebać w tematyce "zachłanne/leniwe Reg.Exp" :-)