Macro che non funziona

[danibi60]

Ciao a tutti,

tempo fa, grazie anche al vostro prezioso supporto, ho creato questo file (che allego) con una macro che permetteva - inserendo un luogo di partenza ed eventuali soste sino a una luogo di destino - di determinare i km di percorrenza e il tempo per ogni tratta (quest'ultimo aspetto ora come ora è irrilevante (se lo calcola tanto meglio, ma non è una priorità) oggi a distanza di mesi ho avuto bisogno di questo file ma nel lanciare l'elaborazione dei km percorsi la macro da un errore di debug che non riesco a risolvere.

Potete aiutarmi?

https://www.dropbox.com/scl/fi/h56uq1ko ... jm0x6&dl=0

Grazie
Danibi

[Anthony47]

Se modifichi la tua macro come segue vedrai che e’ ora di rottamare Internet Explorer e passare a Chrome, o Edge o qualcosa di analogo

Codice: Seleziona tutto

    For row_index = 2 To 11
        myURL = "https://www.google.it/maps/dir"
        If Sheets(1).Range("A" & row_index).Value <> "" Then
            myURL = myURL & "/" & Sheets(1).Range("A" & row_index).Value & "/" & Sheets(1).Range("B" & row_index).Value
           
            If IE Is Nothing Then
                Set IE = CreateObject("InternetExplorer.Application")
                With IE
                    .navigate myURL
                    .Visible = True                              '<<<<< MODIFICARE COSI’
                    Do While .ReadyState <> READYSTATE_COMPLETE
                    Loop
                End With
                Application.Wait Now + TimeValue("00:00:05")
                Stop                                             '<<<< AGGIUGERE QUESTA RIGA
                Set HTMLdoc = IE.document
 ‘sege il resto del codice


(vedi le due righe marcate <<<<)

Chrome (come Edge) puo’ essere manipolato tramite “l’ambiente Selenium”, che devi predisporre sul tuo PC come descritto qui: viewtopic.php?f=26&t=112225

A quel punto il codice della macro che preleva i dati di viaggio puo’ essere questo:

Codice: Seleziona tutto

 Sub Chrome_Google_maps()
    Dim WPage As Object
    Dim myURL As String
    Dim row_index As Integer
'
    For row_index = 2 To 11
        myURL = "https://www.google.it/maps/dir"
        If Sheets(1).Range("A" & row_index).Value <> "" Then
            myURL = myURL & "/" & Sheets(1).Range("A" & row_index).Value & "/" & Sheets(1).Range("B" & row_index).Value
            'Crea Driver:
            If WPage Is Nothing Then
            '    Set WPage = CreateObject("Selenium.EdgeDriver")      'via Edge
                Set WPage = CreateObject("Selenium.CHRomedriver")    'via Chrome
                WPage.get myURL
                WPage.Wait 2000
                WPage.FindElementsByXPath("//*[@id=""yDmH0d""]/c-wiz/div/div/div/div[2]/div[1]/div[3]/div[1]/div[1]/form[2]/div/div/button/span[6]")(1).Click
            End If
            WPage.get myURL
            WPage.Wait 3000
            Debug.Print ">>" & myURL
            Debug.Print WPage.FindElementsByClass("ivN21e")(1).Text
            Debug.Print WPage.FindElementsByClass("Fk3sm")(1).Text
            Sheets(1).Range("C" & row_index).Value = ParseKM(WPage.FindElementsByClass("ivN21e")(1).Text)
            Sheets(1).Range("D" & row_index).Value = ParseTIME(WPage.FindElementsByClass("Fk3sm")(1).Text)
            DoEvents
        Beep
        End If
    Next row_index
    WPage.Quit
    Set WPage = Nothing
End Sub


Anche le due Function ParseTIME e ParseTIME hanno bisogno di essere aggiornate perche’ e’ cambiato il modo in cui Google restituisce le informazioni; il nuovo codice:

Codice: Seleziona tutto

Function ParseKM(str_km As String)
    Dim str_km_split As Variant
    If str_km <> "" Then
        If InStr(1, str_km, "km", vbTextCompare) > 0 Then
            ParseKM = CSng(Replace(str_km, "km", "", , , vbTextCompare))
        ElseIf InStr(1, str_km, "m", vbTextCompare) > 0 Then
            ParseKM = CSng(Replace(str_km, "m", "", , , vbTextCompare)) / 1000
        Else
            ParseKM = 0
        End If
    End If
End Function



Function ParseTIME(str_time As String)
    Dim str_time_split As Variant
    Dim tot_min As Integer
   
    If InStr(1, str_time, "Ore", vbTextCompare) <> 0 And InStr(1, str_time, "min") <> 0 Then
        str_time_split = Split(str_time, "ore", , vbTextCompare)
        tot_min = 60 * CInt(Left(str_time_split(0), Len(str_time_split(0)) - 1))
        tot_min = tot_min + CInt(Split(Split(str_time_split(1), "min", , vbTextCompare)(0))(1))
        ParseTIME = tot_min
    ElseIf InStr(1, str_time, "Ore", vbTextCompare) <> 0 Then
        str_time_split = Split(str_time, "Ore", , vbTextCompare)
        tot_min = 60 * CInt(Left(str_time_split(0), Len(str_time_split(0)) - 1))
        ParseTIME = tot_min
    Else
        str_time_split = Split(str_time, "min")
        ParseTIME = CInt(Left(str_time_split(0), Len(str_time_split(0)) - 1))
    End If
End Function


A me sembra che così funziona, prova anche tu
Ps: TI DEVO SCRIVERE UN MESSAGGIO PRIVATO

[danibi60]

Grazie Anthony, come sempre!