Importare dati Meteorologici Regione Marche

[Anthony47]

Prova modificando
da
Result = ShellExecute(0&, vbNullString, myURL, _
vbNullString, vbNullString, vbNormalFocus)

a:
Result = ShellExecute(0&, vbNullString, myURL, _
vbNullString, vbNullString, 3)

[Paolo67]

sostituito e provato 2 volte...sempre lo stesso errore
Non compare mai il Salva con nome...

[Anthony47]

Controlla se da qualche parte esiste un file Stazioni Rete Linea Meteo.html

Prova con Edge: imposta Edge come il browser di default; apri Edge; poi avvia la macro e segui (guardare ma non toccare) le operazioni a video.
Per impostare Edge, cerca app predefinite e modifica il browser

Poi per stasera avrei esaurito le idee

[Paolo67]

Allora il file stazioniretelineameteo.html non esiste
proverò con edge...
Domani ti saprò dire.
grazie x la disponibilità Anthony.
Buonanotte

[Anthony47]

Su Firefox, controlla in Menu /Strumenti /Opzioni; gruppo Generale, scorri fino a Download: verifica che sia impostato "Chiedi dove salvare ogni file"
Intendi "Stazioni Rete Linea Meteo.html", vero?
E mi confermi che in Firefox con Contr+s (minuscolo) appare la finestra Salva-con-Nome, vero?

Comunque abbiamo esaurito le pile, serve una ricarica...

[Paolo67]

No era settato su "Salva i file in download"
"Stazioni Rete Linea Meteo.html", vero?
Si intendevo quella

[Paolo67]

scaricato EDGE,impostato come preferito,,stessa trafila...
sempre lo stesso errore!
C'è qualcosa che non va.
Boh...andiamo a ricaricarci va...

[Anthony47]

Credo che ci sia un problema di "sicurezza" che a livello di Windows impedisce di "comandare" da excel un'altra applicazione. Mi era successo con Win7 (non su Win10), e non ricordo come l'avevo aggirato.
Tu che sistema operativo usi?

Intanto una prova veloce:
-chiudi Excel, poi da Windows cerca "Excel"; immagino che il primo risultato sara' l'applicazione Excel: tasto dx sulla voce, scegli Esegui come amministratore; poi apri il file e fai la prova.
Se l'esito fosse negativo allora sostituisci il codice attuale con quest'altro:

Codice: Seleziona tutto

#If VBA7 Then       '!!! ON  TOP  OF  THE  VBA  MODULE   !!!!
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

#If VBA7 Then
Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" (ByVal hwnd As Long, _
  ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long
#Else
Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" (ByVal hwnd As Long, _
  ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long
#End If
#If VBA7 Then
    Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
      (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
    Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long
#Else
    Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
      (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Declare Function GetForegroundWindow Lib "user32" () As Long
#End If


Sub GetLineaMeteo()
    Call GetStat(1976)          '<<< Il numero della Stazione  VEDI TESTO!
End Sub

Sub GetStat(StatID As String)
Dim TmpFile As String, htDoc As Object, myID As Object, myTabl As Object
Dim dSh As Worksheet, myFile As String, dFile As String, myURL As String
Dim tDtD As Object, tRtR As Object, myRep, iTx
Dim mmm As Integer
'
Set dSh = Sheets(StatID)
dSh.Range("A:B").ClearContents
'
TmpFile = "C:\PROVA" & "\myStation.html"                    '<<<-1 Vedi Testo
'
    wHand = GetForegroundWindow()
    Debug.Print "Start    ", "Active: " & AWCaption(wHand)

dFile = Replace(TmpFile, ".html", "_files\stazioni.html", , , vbTextCompare)
Debug.Print ">>> " & StatID
myURL = "http://www.lineameteo.it/stazioni.php?id=" & StatID
On Error Resume Next
    Kill TmpFile
    Kill dFile
    Sleep 100
On Error GoTo 0
Result = ShellExecute(0&, vbNullString, myURL, _
    vbNullString, vbNullString, 3&)     'vbNormalFocus)
If Result < 32 Then
    MsgBox "Errore in apertura Pagina web"
    Exit Sub
End If
Sleep 100
Debug.Print Format(Now, "hh:mm:ss"), "Result=" & Result
    wHand = GetForegroundWindow()
    Debug.Print "Browser?.", "Active: " & AWCaption(wHand)
Application.DisplayAlerts = False
'
Sleep 8000                                  '<<<-2 VEDI TESTO
Application.SendKeys "^s", True
Sleep 2000
    wHand = GetForegroundWindow()
    Debug.Print "Save As??", "Active: " & AWCaption(wHand)
skfile = TmpFile & "~"
Application.SendKeys skfile, True
Sleep 200
    wHand = GetForegroundWindow()
    Debug.Print "Post ~   ", "Active: " & AWCaption(wHand)
Debug.Print Format(Now, "hh:mm:ss"), TmpFile
Sleep 3000
Application.SendKeys "^w"
Sleep 500
    wHand = GetForegroundWindow()
    Debug.Print "Browser?:", "Active: " & AWCaption(wHand)

Application.DisplayAlerts = True
'
Set htDoc = CreateObject("HTMLfile") 'late binding alla html obj lib
Set FSO = CreateObject("Scripting.FilesystemObject")
On Error Resume Next
Set PubFile = FSO.OpenTextFile(dFile, 1, False)
    If Err.Number <> 0 Then
        MsgBox "Errore: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Operazione non completata"
        Exit Sub
    End If
On Error GoTo 0
'
'Legge file e compila tabella:
htDoc.Open
htDoc.write PubFile.ReadAll
DoEvents
Sleep 100
PubFile.Close
'
On Error Resume Next
For I = 1 To 20
    Sleep 500
    DoEvents
    Set myID = htDoc.getElementById("tabs-1")
    If Not myID Is Nothing Then Exit For
Next I
On Error GoTo 0
Debug.Print Format(Now, "hh:mm:ss"), "I=" & I
dSh.Range("A1") = myID.getElementsByTagName("h1")(0).innerText
dSh.Range("A2") = myID.getElementsByTagName("span")(1).innerText
Set myTabl = myID.getElementsByTagName("table")(0)
myRep = Array("Ã", "a'", "Â", " ")
I = 3
    For Each tRtR In myTabl.Rows
        For Each tDtD In tRtR.Cells
            iTx = tDtD.innerText
            For k = 0 To UBound(myRep) Step 2
                iTx = Replace(iTx, myRep(k), myRep(k + 1), , , vbTextCompare)
            Next k
            Cells(I + 1, J + 1) = iTx
            J = J + 1
        Next tDtD
        I = I + 1: J = 0
    Next tRtR
    I = I + 1
dSh.Range("B2").Value = "Aggiornato alle: " & Format(Now, "hh:mm:ss")
AppActivate Application.Caption
    wHand = GetForegroundWindow()
    Debug.Print "Excel?   ", "Active: " & AWCaption(wHand)
End Sub

Function AWCaption(ByVal cHand As Long) As String
Dim cTxt As String * 255
    GetWindowText cHand, cTxt, Len(cTxt)
    AWCaption = Trim(cTxt)
End Function


Rispetto alla versione precedente, contiene istruzioni per verificare quali siano le finestre attive durante l'esecuzione delle macro; per cui al completamento della stessa vai sul vba e apri la "finestra Immediata" (l'ho gia' vista visualizzata in qualche immagine che hai allegato); copia le righe visualizzate dall'ultimo "Start ..." fino alla fine, e incollale nel prossimo messaggio, insieme alla descrizione della sequenza che hai visto sullo schermo (attivazione Browser; apertura pagina meteo; finestra Salva con nome?; ritorno alla pagina meteo; ritorno alla pagina preesistente; ritorno a Excel)

Mi devi anche confermare che da Firefox ed Edge, con Contr+s (minuscolo) si apre la finestra Salva-con-nome

Ciao

[Paolo67]

Allora il sistema operativo che uso è Windows7 32 bit
Altra cosa,Excel non mi è possibile avviarlo da amministratore,nel senso che non mi appare lo "scudetto" (cosa che invece avviene con altri software che ho nel pc)...quindi impossibile fare la prova suggerita.
Ho poi sostituito il codice "vecchio" col "nuovo" e lanciata la macro:
Questo è quello che compare nella finestra immediata

Start Active: Microsoft Excel - TEST
>>> 1976
12:35:53 Result=42
Browser?. Active: Microsoft Excel - TEST
Save As?? Active: Stazioni Rete Linea Meteo – Mozilla Firefox
Post ~ Active: Stazioni Rete Linea Meteo – Mozilla Firefox
12:36:03 C:\PROVA\myStation.html
Browser?: Active: Stazioni Rete Linea Meteo – Mozilla Firefox

Riguardo la sequenza che ho visto...è sempre la stessa:
Attivazione browser Firefox (messo di nuovo come principale)
Apertura pagina meteo
Completamento pagina meteo (circa 4-5 sec)
Rimane la pagina meteo aperta,nessun ritorno ad excel
Nessuna finestra che si apre con scritta "Salva con nome..."
In basso vedo lampeggiare l'icona excel (indice di problema...) clicco e mi appare il solito msg di errore.
Ti confermo che da Fireox ed Edge con Ctrl+s mi si apre la finestra "Salva con nome..."
Ho riposizionato il salvataggio del file nella cartella Download
Aspetto tue nuove
ciao

[Paolo67]

Ho provato a cambaire cartella di destinazione...rinominandola:
Mi da sempre errore ma ho queste scritte un pò diverse da quelle precedenti

Start Active: Microsoft Visual Basic - TEST.xls [in esecuzione] - [Modulo1 (codice)]
>>> 1976
13:41:56 Result=42
Browser?. Active: Microsoft Visual Basic - TEST.xls [in esecuzione] - [Modulo1 (codice)]
Save As?? Active: Stazioni Rete Linea Meteo – Mozilla Firefox
Post ~ Active: Stazioni Rete Linea Meteo – Mozilla Firefox
13:42:14 C:\ABC\myStation.html
Browser?: Active: Stazioni Rete Linea Meteo – Mozilla Firefox

[Anthony47]

I log dimostrano che il browser non riceve i comandi di Excel; e' un problema di sicurezza che blocca l'interoperativita' tra applicativi, FORSE elevando la priorita' di Excel si potrebbe risolvere.
Guarda se questi due video che spiegano come eseguire (sempre o spot) Excel in modalita' amministratore sono applicabili al tuo ambiente:
https://www.youtube.com/watch?v=ZinNO5DO2mY
https://www.youtube.com/watch?v=nNVdaJXYCbA

Ciao

[Paolo67]

Ho guardato i 2 video.
Ho fatto la procedura ma quando lancio il file con privilegio di amministratore(almeno così sembra) adesso non mi si apre proprio più:
"errore durante l'invio del comando al programma..."
C'è sempre qualcosa che blocca excel.
Ho spulciato tra i vari menu,cambiato opzioni...niente!
Chissà dove si deve intervenire.
Credo a questo punto la bandiera bianca la alzo io,inutile percorrere questa strada,non se ne vien fuori, almeno io non ne son capace.
A questo punto non so se proporti l'altra alternativa (entrando nel sito ufficiale dal quale lineameteo preleva i dati ossia "retemir regione marche" e vedere se si riesce ad estrapolare qualcosa) oppure fermarci qui.
Se ti va di tentare è previsto il login con email e pwd utente che potrei fornirti inviandotele magari in privato.
Ti ringrazio cmq per la tua disponibilità.
ciao

[Anthony47]

Volendo si riesce a importare dal sito retemir.regione.marche.it, previa registrazione e login.

L'approccio da me adottato:
-su un foglio si inserisca in B1 l'account di accesso al sito, e in B2 la relativa password
-sullo stesso foglio, da A5 verso il basso si inseriscono i codici delle stazioni di cui estrarre i dati
-la macro sviluppata esegue il login al sito, poi cerca le stazioni in successione e posiziona in colonna B:G le informazioni rese disponibili dal sito
-se un codice stazione non viene trovato, la riga rimane vuota

I dati cosi' importati possono poi essere riportati su altri fogli, dove necessario, tramite formule con Cerca.Vert che guarda il codice stazione di colonna A

Il codice della macro:

Codice: Seleziona tutto

#If VBA7 Then       '!!! ON  TOP  OF  THE  VBA  MODULE   !!!!
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub DaReteMir()
Dim IE As Object, myURLb As String, myID As Object
Dim I As Long, skArr, myTim As Single, dSh As Worksheet
'
Set dSh = Sheets("SheetA")                 '<<< Il foglio "parametri"
'
myURLb = "https://retemir.regione.marche.it/meteo/stazioni?codstaz="
Set IE = CreateObject("InternetExplorer.Application")
myTim = Timer
Debug.Print Format(Timer - myTim, "hh:mm:ss"), ">>>"
For I = 5 To dSh.Cells(Rows.Count, "A").End(xlUp).Row
dSh.Cells(I, 2).Resize(1, 6).ClearContents
dSh.Cells(I, 2).Value = "##Cerca##"
    If dSh.Cells(I, 1) <> "" Then
reVai:
        With IE
            Debug.Print Format(Timer - myTim, "0.00"), myURLb & dSh.Cells(I, "A")
            .navigate myURLb & dSh.Cells(I, "A")
            .Visible = True
''        Stop                '*** VEDI Testo
            Do While .Busy: DoEvents: Loop    'Attesa not busy
            Do While .readyState <> 4: DoEvents: Loop 'Attesa documento
        End With
        '
        myStart = Timer  'attesa addizionale
        Sleep 500
        If IE.LocationURL = "https://retemir.regione.marche.it/login" Then
        'eventuale Login:
            Debug.Print Format(Timer - myTim, "0.00"), "Eseguo Login"
            Set myID = IE.document.getElementById("loginform")
            myID.getElementsByTagName("input")(0).Value = dSh.Range("B1").Value
            myID.getElementsByTagName("input")(1).Value = dSh.Range("B2").Value
            Sleep 100
            IE.document.getElementById("btn-login-extended").Click
            Sleep 3000
            runlin = True
            GoTo reVai
        End If
        Debug.Print Format(Timer - myTim, "0.00"), "Arrivato su: " & IE.LocationURL
        If IE.LocationURL <> (myURLb & dSh.Cells(I, 1)) And runlin Then
            MsgBox ("Destinazione non raggiunta, operazione terminata")
            Debug.Print myURL, IE.LocationURL
            GoTo ExitA
        End If
    'Importa dati di Stazione:
        Set mycoll = Nothing
        For J = 1 To 10
            Set mycoll = IE.document.getElementsByClassName("leaflet-popup-content")
            Debug.Print Format(Timer - myTim, "0.00"), "Typename(myColl): " & TypeName(mycoll)
            Debug.Print " ", "Typename(myColl): " & TypeName(mycoll)
            Debug.Print " ", "Items in myColl: " & mycoll.Length
            If mycoll.Length > 0 Then Exit For
            Debug.Print " ", "Loop J=" & J
            Sleep 200
        Next J
        If mycoll.Length > 0 Then
            On Error Resume Next
                skArr = Array("Stazione", "Ultimo agg.", "Total Rain Today :", "Rain Intensity :", "Air Temperature :", "Relative Umidity :")
                Debug.Print Format(Timer - myTim, "0.00"), "Ubound(mySplit): " & UBound(mySplit)
                dSh.Cells(4, 2).Resize(1, 6) = skArr
                mySplit = Split(mycoll(0).innerText, Chr(10), , vbTextCompare)
                dSh.Cells(I, 2) = mySplit(1)
                dSh.Cells(I, 3) = Replace(mySplit(3), skArr(1), "", , , vbTextCompare)
                dSh.Cells(I, 4) = Replace(mySplit(4), skArr(2), "", , , vbTextCompare)
                dSh.Cells(I, 5) = Replace(mySplit(5), skArr(3), "", , , vbTextCompare)
                dSh.Cells(I, 6) = Replace(mySplit(6), skArr(4), "", , , vbTextCompare)
                dSh.Cells(I, 7) = Replace(mySplit(7), skArr(5), "", , , vbTextCompare)
            On Error GoTo 0
        End If
    End If
Next I
'Chiudi IE e completa
Debug.Print Format(Timer - myTim, "0.00"), "Completato"
ExitA:
IE.Quit
Set IE = Nothing
End Sub


Va messo in un modulo standard inizialmente vuoto del tuo progetto vba.

La riga marcata <<< va modificata col nome del foglio che contiene i parametri di login e i codici stazione, e in cui verranno assemblati i riisultati

Come tutti gli sviluppi che lavoraro sul codice html di siti web, e' garantito che nel futuro piu' o meno prossimo il gestore del sito cambiera' qualcosa e la macro non funzionera' piu'.

Ciao!

[Paolo67]

Ciao Anthony,
grazie per il tuo ennesimo tentativo nel cercare di risolvere il mio problema.
Allora ho fatto come da te indicato ma per sicurezza ti elenco le azioni per essere sicuro di non aver sbagliato.
Nel foglio di lavoro che ho chiamato TEST,nel Foglio1 ho inserito il codice in un modulo standard.
In questo codice nella riga evidenziata '<<<<<< Il foglio "parametri" ho inserito:
Set dSh = Sheets("Foglio1")

Nel foglio1 ho inserito nella casella B1 la user id che è la mia email e nella casella B2 la pwd.
Infine nella cella A5 ho messo l'id dell stazione che è 719.

Lancio la macro,mi si apre internet Explorer (Versione11 ma con la precedente era la stessa cosa...) questa si collega al sito ma mi esce un msg:
Si è verificato un problema con il certificato di sicurezza del sito web.


la finestra si chiude e si interrompe l'acquisizione.
Nella finestra immediata mi appare questo:
00:00:00 >>>
0,16 https://retemir.regione.marche.it/meteo ... odstaz=711
4,16 Arrivato su: https://retemir.regione.marche.it/meteo ... odstaz=711
4,20 Typename(myColl): DispHTMLElementCollection
Typename(myColl): DispHTMLElementCollection
Items in myColl: 0
Loop J=1
4,48 Typename(myColl): DispHTMLElementCollection
Typename(myColl): DispHTMLElementCollection
Items in myColl: 0
Loop J=2
4,70 Typename(myColl): DispHTMLElementCollection
Typename(myColl): DispHTMLElementCollection
Items in myColl: 0
Loop J=3
4,91 Typename(myColl): DispHTMLElementCollection
Typename(myColl): DispHTMLElementCollection
Items in myColl: 0
Loop J=4
5,13 Typename(myColl): DispHTMLElementCollection
Typename(myColl): DispHTMLElementCollection
Items in myColl: 0
Loop J=5
5,35 Typename(myColl): DispHTMLElementCollection
Typename(myColl): DispHTMLElementCollection
Items in myColl: 0
Loop J=6
5,57 Typename(myColl): DispHTMLElementCollection
Typename(myColl): DispHTMLElementCollection
Items in myColl: 0
Loop J=7
5,79 Typename(myColl): DispHTMLElementCollection
Typename(myColl): DispHTMLElementCollection
Items in myColl: 0
Loop J=8
6,01 Typename(myColl): DispHTMLElementCollection
Typename(myColl): DispHTMLElementCollection
Items in myColl: 0
Loop J=9
6,23 Typename(myColl): DispHTMLElementCollection
Typename(myColl): DispHTMLElementCollection
Items in myColl: 0
Loop J=10
6,45 Completato

Anche senza questa macro tutte le volte che voglio accedere al sito in questione mi appare questo Messaggio che mi blocca momentaneamennte l'accesso alla pagina.
Io lo risolvo cliccando sulla opzione "Continuare con il sito web...scelta non consigliata".
A questo punto mi esce la finestra di login ed accedo normalmente.

Credo sia questo il problema,ma si dovrebbe automatizzare la cosa.
Che pensi?
PS:Con firefox non ho questo problema...

[Paolo67]

Aggiornamento:
Ho provato ad allungare il tempo nella stringa portandolo a 20 sec
myStart = Timer 'attesa addizionale
Sleep 20000
Ho avuto così il tempo di cliccare sull' opzione e far ricaricare i dati alla pagina.
L'acquisizione è avvenuta correttamente ed i dati sono finalmente apparsi nel foglio!
A questo punto credo bisogni solo automatizzare questo processo

[Paolo67]

Altra cosa...a distanza di oltre 1 ora noto che l'aggiornamento dei parametri non avviene.
In pratica quando si apre la pagina della stazione i dati visualizzati sono "vecchi",relativi al primo accesso effettuato in questo caso almeno 1 ora prima.
L'aggiornamento non "aggiorna"

[Anthony47]

Non so quali sono le impostazioni di sicurezza del tuo pc che portano IE a non accettare il cerificato di sicurezza del sito; la sicurezza non e' modificabile da vba
Quanto all'aggiornamento, anche io vedo qualche stazione (es Maiano-803) che non e' aggiornata da ...qualche giorno; Baraccola - e' in ritardo di 1:30; Endesa - 171 e' indietro di 3 ore... Insomma non credo che l'aggiornamento sia proprio real-time. Se comunque ci sono stazioni che su IE dice un orario di aggiornamento e sull'importazione ne dice un'altra dimmelo che possiamo vedere.

Guardando invece meglio i dati, mi accorgo che non tutte le stazioni restituiscono lo stesso numero di dati: alcune resituiscono 2 parametri, altre 7, altre 10, altre 11. Quindi la mia raccolta "posizionale" fallisce su molte stazioni.
Ne' tutte parlano lo stesso linguaggio: es alcune riportano "Intensità Pioggia", altre "Intensità di Pioggia", altre "Rain Intensity"; e qualcuna restituisce degli strafalcioni, es " Total Rain Todaly" (Monte San Vicino - 733) invece che " Total Rain Today".
Questo mi ha portato a rivedere il modo con cui estraggo le info dalla risposta della stazione, usando un dizionario di termini da cercare nella risposta piu' una nuova Funzione

Il codice aggiornato quindi e' diventato:

Codice: Seleziona tutto

#If VBA7 Then       '!!! ON  TOP  OF  THE  VBA  MODULE   !!!!
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub DaReteMir()
Dim IE As Object, myURLb As String, myID As Object
Dim I As Long, skArr, myTim As Single, dSh As Worksheet
Dim ArrSk(1 To 3)
'
Set dSh = Sheets("SheetA")                 '<<< Il foglio "parametri"
'
myURLb = "https://retemir.regione.marche.it/meteo/stazioni?codstaz="
Set IE = CreateObject("InternetExplorer.Application")
myTim = Timer
Debug.Print Format(Timer - myTim, "hh:mm:ss"), ">>>"
skArr = Array("Stazione", "Ultimo agg.", "Total Rain Today :", "Rain Intensity :", "Air Temperature :", "Relative Umidity :")
skArr1 = Array("Stazione", "Ultimo agg.", "Total Rain Todaly :", "Intensità Pioggia :", "Temperatura Aria :", "Umidità Relativa :")
skArr2 = Array("Stazione", "Ultimo agg.", "Pioggia TOT Oggi :", "Intensità di Pioggia :", "Temperatura Aria :", "Umidità Relativa :")
ArrSk(1) = skArr
ArrSk(2) = skArr1
ArrSk(3) = skArr2
For I = 5 To dSh.Cells(Rows.Count, "A").End(xlUp).Row
    dSh.Cells(I, 2).Resize(1, 6).ClearContents
    dSh.Cells(I, 2).Value = "##Cerca##"
    If dSh.Cells(I, 1) <> "" Then
reVai:
        With IE
            Debug.Print Format(Timer - myTim, "0.00"), myURLb & dSh.Cells(I, "A")
           
            .navigate myURLb & dSh.Cells(I, "A")
            .Visible = True
''        Stop                '*** VEDI Testo
            Do While .Busy: DoEvents: Loop    'Attesa not busy
            Do While .readyState <> 4: DoEvents: Loop 'Attesa documento
        End With
        '
        myStart = Timer  'attesa addizionale
        Sleep 500
        If IE.LocationURL = "https://retemir.regione.marche.it/login" Then
        'eventuale Login:
            Debug.Print Format(Timer - myTim, "0.00"), "Eseguo Login"
           
            Set myID = IE.document.getElementById("loginform")
            myID.getElementsByTagName("input")(0).Value = dSh.Range("B1").Value
            myID.getElementsByTagName("input")(1).Value = dSh.Range("B2").Value
            Sleep 100
            IE.document.getElementById("btn-login-extended").Click
            Sleep 3000
            runlin = True
            GoTo reVai
        End If
        Debug.Print Format(Timer - myTim, "0.00"), "Arrivato su: " & IE.LocationURL
       
        If IE.LocationURL <> (myURLb & dSh.Cells(I, 1)) And runlin Then
            MsgBox ("Destinazione non raggiunta, operazione terminata")
            Debug.Print myURL, IE.LocationURL
            GoTo ExitA
        End If
    'Importa dati di Stazione:
        Set myColl = Nothing
        For J = 1 To 10
            Set myColl = IE.document.getElementsByClassName("leaflet-popup-content")
            If myColl.Length > 0 Then Exit For
            Sleep 200
        Next J
            Debug.Print Format(Timer - myTim, "0.00"), "Typename(myColl): " & TypeName(myColl)
            Debug.Print " ", "Items in myColl: " & myColl.Length
            Debug.Print " ", "Loop J=" & J
       
        If myColl.Length > 0 Then
            On Error Resume Next
                Debug.Print Format(Timer - myTim, "0.00"), "Ubound(mySplit): " & UBound(mySplit)
                dSh.Cells(4, 2).Resize(1, 6) = skArr
                mySplit = Split(myColl(0).innerText, Chr(10), , vbTextCompare)
                dSh.Cells(I, 2) = mySplit(1)
                dSh.Cells(I, 3) = GimmeVal(ArrSk, 1, myColl(0).innerText)
                dSh.Cells(I, 4) = GimmeVal(ArrSk, 2, myColl(0).innerText)
                dSh.Cells(I, 5) = GimmeVal(ArrSk, 3, myColl(0).innerText)
                dSh.Cells(I, 6) = GimmeVal(ArrSk, 4, myColl(0).innerText)
                dSh.Cells(I, 7) = GimmeVal(ArrSk, 5, myColl(0).innerText)
            On Error GoTo 0
        End If
    End If
Next I
'Chiudi IE e completa
Debug.Print Format(Timer - myTim, "0.00"), "Completato"
ExitA:
IE.Quit
Set IE = Nothing
End Sub


Function GimmeVal(ByRef ArrArr, ByVal iInd As Long, ByVal InnerT As String) As Variant
Dim myPos As Long, I As Long, UpTo As Long
If Len(InnerT) < 5 Then Exit Function
For I = 1 To 3
'    Set larr = ArrArr(I)
    myPos = InStr(1, InnerT, ArrArr(I)(iInd), vbTextCompare)
    If myPos > 0 Then Exit For
Next I
If myPos = 0 Then Exit Function
UpTo = InStr(myPos, InnerT & Chr(10), Chr(10), vbTextCompare)
GimmeVal = Mid(InnerT, myPos + Len(ArrArr(I)(iInd)), UpTo - myPos - Len(ArrArr(I)(iInd)))
End Function


Sostituisce in toto il codice precedente; le modalita' di utilizzo rimangono invariate

Ciao

[Paolo67]

Non so perchè mi dia questo errore di certificato di sicurezza.
A te non te lo da con Internet Explorer?
Non si può creare una macro che simulando la mia mano,quando compare la pagina di errore vada a cliccare sullo scudetto "Continuare con il sito web..."?
Riguardo le stazioni ho notato anche io che molte aggiornano "random".
Di tutte queste centinaia di stazioni a me ne servono solo 2 il resto non mi interessano.
Fortunatamente queste 2 aggiornano costantemente ogni 15 min circa.
Sono la 719 e la 702.
Il problema serio che se non risolto diventa per me motivo di inutilizzo di tutto questo "marchingegno" è l'aggiornamento che purtroppo non si verifica se non solo per la prima volta.
Eppure le 2 stazioni si aggiornano costantemente su internet controllando direttamente la pagina con IE.
Tramite la macro mi si apre sempre invece il dato vecchio risalente al 1° accesso fatto magari 10 ore prima.
Non so, forse bisognerebbe prima far fare un refresh della pagina...boh!
Ti mostro 2 screenshot:
Il primo dimostra che lanciando la macro il dato dellla stazione Carpegna rimane fisso ale 21:45 (45 minuti fa...)
Il secondo è l'accesso diretto al sito con un'altra sessione di IE.La stazione è aggiornata alle 22:30 (7 minuti fa).


(per visualizzare l'immagine completa: tasto dx, visualizza immagine)


Ciao

[Anthony47]

Come detto le impostazioni di sicurezza non sono modificabili da programma (altrimenti i primi a farlo sarebbero i virus)

Per quanto riguarda l'aggiornamento, prova a impostare in IE la cancellazione in chiusura: Menu /Strumenti /Opzioni internet; scheda Generale, spunta la voce "Elimina la cronologia al momento di uscire"
A me l'aggiornamento dei dati importati avviene regolarmente (sia Carpegna che Monte Carpegna mi pare che aggiornino ogni 15 min; comunque quello che vedo in Excel e' pari a quello che vedo in altra sessione Firefox)

[Paolo67]

Fatta la cancellazione in chiusura di IE e problema sparito:aggiornamento che si verifica con successo!!
Riguardo la pagina di sicurezza che mi appare...allora mi sembra di capire che non c'è modo di agirare l'ostacolo immettendo un codice che dopo x sec dal lancio della macro vada a fare clic col puntatore del mouse sulla finestra attiva del browse in una parte precisa dello schermo.
Peccato!