Forum Coders' city Strona Główna Coders' city
Nasza pasja to programowanie!
 

 PomocPomoc   SzukajSzukaj   UżytkownicyUżytkownicy   GrupyGrupy  RejestracjaRejestracja 
Archiwum starego forum + teoria    RSS & Panel/SideBar
 ProfilProfil   Zaloguj się, by sprawdzić wiadomościZaloguj się, by sprawdzić wiadomości   ZalogujZaloguj 

Potrzebuję szybkiej odpowiedzi na moje pytanie... Zasady

[VBA] - Czas przejazdu między dwoma punktami pobierane z Google Maps



 
Odpowiedz do tematu    Forum Coders' city Strona Główna -> Oprogramowanie biurowe
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
SZWAJCAR007



Dołączył: 10 Mar 2017
Posty: 17

PostWysłany: Pią Sty 26, 2018 10:22 am  OP    Temat postu: [VBA] - Czas przejazdu między dwoma punktami pobierane z Google Maps Odpowiedz z cytatem Pisownia

Witam
Mam taki kod VBA, który ma pobierać informację z Google Maps o czasie przejazdu między dwoma punktami. Wynik jaki daje ten kod w żaden sposób nie odzwierciedla rzeczywistego przejazdu ( porównanie czasu ze strony google maps).

Kod:

    Function G_Duration(Origin As String, Destination As String, Optional Requery As Boolean) As Double 'ok
        Dim myRequest As XMLHTTP60
        Dim tempFile As String
        Dim strTemp As String
        Dim nextFileNum As Long

        G_Duration = 0
        On Error GoTo exitRoute

        Origin = CleanQuery(Origin)
        Destination = CleanQuery(Destination)
        ' Check for cached version
        tempFile = Environ("temp") & "\" & Origin & "_" & Destination & ".tmpdst"

       If (Len(Dir(tempFile)) = 0) Or Requery Then ' query Google
            ' Read the XML data from the Google Maps API
            myRequest = New XMLHTTP60
            myRequest.Open("GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=")
        Else ' otherwise query the temp file
            nextFileNum = FreeFile
              Open tempFile For Input As #nextFileNum
              Line Input #nextFileNum, strTemp
            G_Duration = strTemp
            GoTo exitRoute
        End If

        exitRoute:
        ' Tidy up memory
        Close #nextFileNum
        ' Kill tempFile
        myRequest = Nothing
    End Function


Ze względu na treść tematu:( VBA ) -> wątek przeniesiony do tego działu - Samlot
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
samolot



Dołączył: 26 Sty 2006
Posty: 8268
Skąd: Toruń

PostWysłany: Pią Sty 26, 2018 9:25 pm      Temat postu: Odpowiedz z cytatem Pisownia

Cytat:
...kod w żaden sposób nie odzwierciedla rzeczywistego przejazdu

1. Jak zauważyłeś, watek przeniosłem do działu "Oprogramowanie biurowe" , bo ty go napisałeś w dziale "Komputery". Skoro już na wstępnie pomyliłeś działy, to jaką ma kto inny mieć pewność, że to, co napisałeś o nie działaniu kodu, dokładnie sprawdziłeś?

2. To co wkleiłeś było nieczytelne, więc sformatowałem twój kod - taki jest łatwiejszy do analizy

3. Ponieważ wkleiłeś tylko kod funkcji , która w swym nagłówku powinna otrzymać parametry wejściowe
Cytat:
Origin As String,
Destination As String,
Optional Requery As Boolean

i poza tym kodem nic więcej, to z tego powodu nie wiedomo, jakie wartości te zmienne przyjmują na wejściu funkcji. To Jak więc sobie wyobrażasz, aby ktoś inny to sprawdził, czy funkcja działa prawidłowo?

_________________
Nie zadawaj bezcelowych pytań / Windows 8.1 / Windows 10 / VB2008 / VB 2010 / VB 2012 / Pisz poprawnie
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość Wyślij email
SZWAJCAR007



Dołączył: 10 Mar 2017
Posty: 17

PostWysłany: Sob Sty 27, 2018 12:28 am  OP    Temat postu: Odpowiedz z cytatem Pisownia

Nie bardzo rozumiem twoją wypowiedź, ale wydaje mi się, że o te dane Ci chodziło

Wklejając ten kod do modułu w VBA i w excelu w komórce wpisując funkcję do komórki A3 daje teraz wynik w metrach a powinien podawać czas. Dodam, że w komórce A1 jest miasto startowe a w komórce A2 miasto docelowe.
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
mrowek



Dołączył: 28 Maj 2005
Posty: 330
Skąd: pniewy wlkp

PostWysłany: Wto Lut 13, 2018 10:39 pm      Temat postu: Odpowiedz z cytatem Pisownia

samolot jak to bylo w excelu to zmienne wejsciowe moga byc zakresami i nie są wtedy potrzebne w naglowku funkcji.


co do wątku
podejrzewam ze op nie ogarnia vba w takim stopniu jaki wymaga te zadanie ;)

Kod:

      myRequest.Open("GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=")



tutaj request idacy do serwera jest prawdopodobnie bledny bo uri wyglada na niekompletne, parametr origin jest pusty (origin jako miejsce pierwotne) a cel podrozy rowniez nie nie jest ustawiony (direction)

na stronie google jest opis api tego wywolania:

https://developers.google.com/maps/documentation/directions/intro
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość Numer GG
losmac



Dołączył: 25 Maj 2005
Posty: 1558
Skąd: Białystok

PostWysłany: Pon Mar 05, 2018 2:21 pm      Temat postu: Odpowiedz z cytatem Pisownia

Zgodnie z dokumentacją Google Maps API's, żądanie może zwrócić obiekt JSON lub XML o określonej strukturze. Dla JSON wygląda to tak:
Kod:
{
   "destination_addresses" : [ "New York, NY, USA" ],
   "origin_addresses" : [ "Washington, DC, USA" ],
   "rows" : [
      {
         "elements" : [
            {
               "distance" : {
                  "text" : "225 mi",
                  "value" : 361715
               },
               "duration" : {
                  "text" : "3 hours 49 mins",
                  "value" : 13725
               },
               "status" : "OK"
            }
         ]
      }
   ],
   "status" : "OK"
}


Jak widać, zwracanych jest kilka wartości:
1. miejsce: docelowe i początkowe
2. odległość: jako wartość tekstowa i numeryczna
3. czas: jako wartość tekstowa i numeryczna
Dodatkowo zwracane są informacje o powodzeniu lub niepowodzeniu operacji {"OK" lub "INVALID_REQUEST"}.

W zależności od parametrów wywołania usługi (np. typ transportu), zwracane wartości dla odległości i czasu mogą być różne.

Ze wskazaną przez Ciebie funkcją jest taki problem, że jest ona niekompletna...

Jako ciekawostkę, na bazie własnych doświadczeń, mogę wskazać, że dodatkowym problemem z usługą Google Maps jest to, że z poziomu VBA wywoływanie usługi z miejscowościami zawierającymi polskie znaczki powoduje to, że usługa się "wykłada", bo najczęściej zwraca wspomniany"INVALID_REQUEST".
Jedynym wyjściem jest zamiana polskich znaczków przed wywołaniem usługi.

Jakiś czas temu zmuszony byłem napisać makro, które musiało zwracać informację o odległościach między miejscowościami. Mając świadomość, że kod nie jest doskonały, zrobiłem coś takiego:
Kod:
Option Explicit

Function GetDistance(ByVal sFrom As String, ByVal sTo As String) As Variant
    Dim sRetVal As Variant, sUrl As String
    Dim oRequest As Object, oXml As Object, oNode As Object

    On Error GoTo Err_GetDistance

   sRetVal = ""
    sUrl = "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & EncodeText(sFrom) & "&destinations=" & EncodeText(sTo) & "&sensor=false"
    'sUrl = "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & sFrom & "&destinations=" & sTo & "&sensor=false"

    Set oRequest = CreateObject("MSXML2.XMLHTTP")
    oRequest.Open "POST", sUrl, False
    oRequest.Send
  
    'Debug.Print oRequest.ResponseText

    Set oXml = CreateObject("MSXML2.DOMDocument")
    oXml.loadXML oRequest.ResponseText
    Set oNode = oXml.selectSingleNode("//status")
    Select Case oNode.Text
        Case "OK"
            'Set oNode = oXml.selectSingleNode("//row/element/distance/text") 'returns srting, for example: "88.8 km"
            Set oNode = oXml.selectSingleNode("//row/element/distance/value") 'returns value in meters
            sRetVal = CLng(oNode.Text) / 1000 'm->km

        Case "INVALID_REQUEST"
            Set oNode = oXml.selectSingleNode("//error_message")
            sRetVal = oNode.Text 'get error message

    End Select

Exit_GetDistance:
    GetDistance = sRetVal
    Set oRequest = Nothing
    Set oXml = Nothing
    Set oNode = Nothing
    Exit Function

Err_GetDistance:
    sRetVal = "Err. " & Err.Number
    Resume Exit_GetDistance

End Function

Function EncodeText(ByVal sInput As String) As String

sInput = LCase(sInput)
sInput = Replace(sInput, "ą", "a")
sInput = Replace(sInput, "ć", "c")
sInput = Replace(sInput, "ł", "l")
sInput = Replace(sInput, "ó", "o")
sInput = Replace(sInput, "ś", "s")
sInput = Replace(sInput, "ź", "z")
sInput = Replace(sInput, "ż", "z")

EncodeText = sInput

End Function


Aby zwrócić czas, zamień:
Kod:
Set oNode = oXml.selectSingleNode("//row/element/distance/value")

na:
Kod:
Set oNode = oXml.selectSingleNode("//row/element/duration/value")

i odpowiednio zamień nazwę funkcji

_________________
książka o VBA dla Office'a
źródło wiedzy o programowaniu w VBA
UWAGA! Nie odpowiadam na PW, jeżeli wcześniej nie zostało to ze mną ustalone w ramach konkretnego wątku!
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość Odwiedź stronę autora
jacekq



Dołączył: 13 Kwi 2006
Posty: 2205
Skąd: Wrocław

PostWysłany: Wto Mar 06, 2018 9:11 am      Temat postu: Odpowiedz z cytatem Pisownia

losmac napisał:
Jako ciekawostkę, na bazie własnych doświadczeń, mogę wskazać, że dodatkowym problemem z usługą Google Maps jest to, że z poziomu VBA wywoływanie usługi z miejscowościami zawierającymi polskie znaczki powoduje to, że usługa się "wykłada", bo najczęściej zwraca wspomniany"INVALID_REQUEST".


Zadziała zamiana z UTF16 na UTF8.
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość Wyślij email
SZWAJCAR007



Dołączył: 10 Mar 2017
Posty: 17

PostWysłany: Pon Mar 26, 2018 7:00 am  OP    Temat postu: Odpowiedz z cytatem Pisownia

Dzięki wielkie za pomoc
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
Wyświetl posty z ostatnich:   
Odpowiedz do tematu    Forum Coders' city Strona Główna -> Oprogramowanie biurowe Wszystkie czasy w strefie CET (Europa)

Strona 1 z 1

 
Skocz do:  
Możesz pisać nowe tematy
Możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Możesz dodawać załączniki na tym forum
Możesz pobierać pliki z tego forum




Debug: strone wygenerowano w 0.15516 sekund, zapytan = 11
contact

| Darmowe programy i porady Jelcyna | Tansze zakupy w Helionie | MS Office Blog |