Condividi:        

Importare dati Meteorologici Regione Marche

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Re: Importare dati Meteorologici Regione Marche

Postdi Anthony47 » 04/05/21 00:04

Ripeto, se fosse possibile aggirare da programma le regole di sicurezza i virus avrebbero vita facile...

Non sono un esperto di sicurezza, ma prova a inserire il dominio retemir.regione.marche.it tra i siti attendibili, tramite Menu /Strumenti /Opzioni internet di IE:
-sulla scheda Sicurezza, seleziona "Siti attendibili" e premi "Siti"; potrai inserire il dominio https://retemir.regione.marche.it e aggiungerlo all'elenco; poi Chiudi e Ok per salvare le impostazioni.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19268
Iscritto il: 21/03/06 16:03
Località: Ivrea

Sponsor
 

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 04/05/21 09:36

Purtroppo non si risolve la cosa.
Ho provato ad installare il certificato autofirmato Microsoft Windows Small Business Server 2003 (Windows SBS) sul computer.
Ho anche impostato manualmente il sito web come “affidabile” seguendo le tue istruzioni.
Niente da fare,me ne farò una ragione!

PS:ma non si può far svolgere la routine da Firefox?
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Importare dati Meteorologici Regione Marche

Postdi Anthony47 » 04/05/21 11:02

Abbiamo gia' provato altre macro che usano Firefox, e non sono finite meglio (sul tuo PC :D )...

Ho modificato il codice:
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
Dim IE As Object


Sub DaReteMir()
Dim myURLb As String, myID As Object
Dim I As Long, skArr, myTim As Single, dSh As Worksheet
Dim ArrSk(1 To 3), noStop As Boolean
'
Set dSh = Sheets("SheetA")                 '<<< Il foglio "parametri"
'
myURLb = "https://retemir.regione.marche.it/meteo/stazioni?codstaz="
If IE Is Nothing Then
    noStop = False
    Set IE = CreateObject("InternetExplorer.Application")
Else
    noStop = True
End If
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
Debug.Print "Via >>>>> " & Format(Now, "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
            If noStop = False Then
                Debug.Print "Halt per Autorizzazione su IE"
                MsgBox ("Autorizzare IE")
                .navigate myURLb & dSh.Cells(I, "A")
                noStop = True
            Else
               
            End If
''        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

Le modifiche sono poche e concentrate in due punti, ma preferisco pubblicare il codice complessivo, che sostituisce integralmente quello precedente.

Con questo codice, la prima volta che lanci la macro dovrebbe uscirti su Excel un messaggio che dice di "Autorizzare IE"; fai manualmente le operazioni che fai oggi e poi chiudi il messaggio per far procedere la macro.

A conclusione, IE non viene piu' chiuso, e rimane disponibile per le volte successive, quando non dovrebbe piu' contestare il certificato del sito; quindi le volte successive la macro dovrebbe completarsi senza interruzioni.
Se il file venisse chiuso, IE rimane aperto ma non utilizzabile per le sessioni successive, quando una nuova sessione IE sara' aperta e la macro si fermera' per darti tempo di concedere le autorizzazioni.
Ci saranno certamente situazioni in cui il sincronismo tra macro e IE verra' perso; in questo caso il suggerimento e' di chiudere IE e chiudere /riaprire il file.

Buone prove...
Avatar utente
Anthony47
Moderatore
 
Post: 19268
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare dati Meteorologici Regione Marche

Postdi Anthony47 » 04/05/21 13:37

Eh he... Ma così facendo IE non viene chiuso e quindi si ripresentera' il problema del mancato aggiornamento... :-?

Comunque se mi confermi che almeno IE si apre e riapre senza interventi (limitati alla prima volta) possiamo poi vedere uno script per azzerare cronolgia e cache di IE e forse arrivare alla meta.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19268
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 04/05/21 16:27

Te lo stavo scrivendo...mi hai preceduto :D
Il codice funge ma non avviene l'aggiornamento perchè non si chiude IE (è un gatto che si morde la coda... :lol: )
Ti confermo che IE rimane aperto e che le richieste di aggiornamento successive alla prima funzionano...che poi non si aggiornano l'abbiamo intuito.

PS:Potresti farmi apparire il pop-up del messaggio che dice di "Autorizzare IE" in primo piano? Rimane nascosto dalla pagina attiva di IE.
PS2 potresti ridurre ad icona IE dopo lo scarico dei dati?
:roll:
PS:Mi sa che ti sto facendo impazzire
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 04/05/21 17:22

Una cosa che ho notato è che quando importo un dato proveniente dal foglio "ReteMir" in un altro foglio (ma anche nello stesso è uguale...),questo risulta come formattato in modo strano,come se fosse testo...o qualcos'altro restituendomi un errore.
Ad esempio l'orario riportato della stazione 719 è riferito all'ora solare (GMT+1).
Visto che siamo in ora legale ossia GMt+2 ho impostato una semplice formula per aumentare in questo caso di 1 ora l'orario:
Se in C5 mi compare "04/05/2021 16:15" e voglio far attuare la modificare nella cella H5,in quest'ultima scrivo =C5+1/24 ma mi viene restituito un errore:
#VALORE! ossia un valore utilizzato nella formula è del tipo dati errato
:roll:
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 05/05/21 19:36

Paolo67 ha scritto:Una cosa che ho notato è che quando importo un dato proveniente dal foglio "ReteMir" in un altro foglio (ma anche nello stesso è uguale...),questo risulta come formattato in modo strano,come se fosse testo...o qualcos'altro restituendomi un errore.
Ad esempio l'orario riportato della stazione 719 è riferito all'ora solare (GMT+1).
Visto che siamo in ora legale ossia GMt+2 ho impostato una semplice formula per aumentare in questo caso di 1 ora l'orario:
Se in C5 mi compare "04/05/2021 16:15" e voglio far attuare la modificare nella cella H5,in quest'ultima scrivo =C5+1/24 ma mi viene restituito un errore:
#VALORE! ossia un valore utilizzato nella formula è del tipo dati errato
:roll:

Risolto!Stavo impazzendo poi ho trovato la soluzione!
Bisognava interrompere le interruzioni di linea dalla cella,questo carattere viene generalmente usato nelle pagine Web come entità HTML &nbsp;
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Importare dati Meteorologici Regione Marche

Postdi Anthony47 » 05/05/21 23:08

Allora…
Una cosa che ho notato è che quando importo un dato proveniente dal foglio "ReteMir" in un altro foglio (ma anche nello stesso è uguale...),questo risulta come formattato in modo strano,come se fosse testo...o qualcos'altro restituendomi un errore
Come hai intuito, il testo importato contiene caratteri spuri (CR, nel nostro caso); li elimino all'interno della nuova Function GimmeVal usando la WorksheetFunction.Clean

Quanto al "gioco" con le finestre attive, anche questo e' fortemente condizionato dalle impostazioni di sicurezza (si pensi a un virus che potrebbe farti comparire una finestra sua camuffata come la tua applicazione preferita); insomma non e' detto che vada tutto come dovrebbe. Ho comunque aggiunta una Function OnTop che dovrebbe attivare ora una finestra ora l'altra, e la richiamo dall'interno della nuova Sub DaReteMir.
Si appoggiano su nuove Api, dichiarate in testa come le altre: Function BringWindowToTop (imposta la finestra attiva), Function GetWindowText (legge l'intestazione delle finestre) e Function GetForegroundWindow (identifica la finestra attiva)
Quanto all'ipotesi che, lasciando IE attivo tra una query e la successiva, le pagine web non si aggiornassero stranamente a me il problema non si presenta; cioe' a ogni interrogazione il dato risulta correttamente aggiornato. Ho tuttavia inserito le istruzioni per pulire i dati di navigazione prima delle nuove query.
Il nuovo codice complessivo:
Codice: Seleziona tutto
#If VBA7 Then        'STRICTLY ON TOP OF A STANDARD MODULE
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    Declare PtrSafe Function ShowWindow Lib "user32" (ByVal Hwnd As Long, ByVal nCmdSHow As Long) As LongPtr
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Declare Function ShowWindow Lib "user32" (ByVal Hwnd As Long, ByVal nCmdSHow As Long) As Long
#End If
''Declare Function SetForegroundWindow Lib "user32.dll" (ByVal Hwnd As Long) As Long
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function BringWindowToTop Lib "user32" (ByVal Hwnd As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal Hwnd As Long, _
    ByVal lpString As String, ByVal cch As Long) As Long
   
Dim IE As Object


Sub DaReteMir()
Dim myURLb As String, myID As Object
Dim I As Long, skArr, myTim As Single, dSh As Worksheet
Dim ArrSk(1 To 3), noStop As Boolean
Dim eHwnd As Long, ieHwnd As Long
'
Set dSh = Sheets("SheetA")                 '<<< Il foglio "parametri"
'
eHwnd = Application.Hwnd
myURLb = "https://retemir.regione.marche.it/meteo/stazioni?codstaz="
If IE Is Nothing Then
    noStop = False
    Set IE = CreateObject("InternetExplorer.Application")
Else
    noStop = True
End If
ieHwnd = IE.Hwnd
Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 3" 'Cokies + history
Sleep 1000

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
Debug.Print "Via >>>>> " & Format(Now, "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
            If noStop = False Then
                Debug.Print "Halt per Autorizzazione su IE"
                Sleep 100
                rispo = OnTop(eHwnd, 5)
                Debug.Print "Requested XL: " & eHwnd, "Got: " & rispo
                MsgBox ("Autorizzare IE")
                .navigate myURLb & dSh.Cells(I, "A")
                noStop = True
                rispo = OnTop(ieHwnd, 5)
                Debug.Print "Requested IE: " & ieHwnd, "Got: " & rispo
            Else
                rispo = OnTop(ieHwnd, 5)
                Debug.Print "Requested IE: " & ieHwnd, "Got: " & rispo
            End If
            Do While .Busy: DoEvents: Loop    'Attesa not busy
            Do While .readyState <> 4: DoEvents: Loop 'Attesa documento
        End With
        '
        myStart = Timer  'attesa addizionale
        Sleep 200
        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"
rispo = OnTop(eHwnd, 5)
Debug.Print "Requested XL: " & eHwnd, "Got: " & rispo
DoEvents

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 = Application.WorksheetFunction.Clean(Mid(InnerT, myPos + Len(ArrArr(I)(iInd)), UpTo - myPos - Len(ArrArr(I)(iInd))))
End Function

Function OnTop(ByVal Handle As Long, Optional ByVal MaxI As Long = 5) As Long
Dim II As Long, CW As Long, WinText As String, cCapt As String

BringWindowToTop (Handle)
For II = 1 To MaxI
    CW = GetForegroundWindow
    Sleep 100: DoEvents
    If CW = Handle Then Exit For
Next II
WinText = String(255, vbNullChar)
cCapt = GetWindowText(Handle, WinText, 255)
cCapt = Application.WorksheetFunction.Clean(WinText)
Debug.Print "Bring On Top: " & Handle, II, cCapt
OnTop = CW

End Function

Prova anche tu…
Avatar utente
Anthony47
Moderatore
 
Post: 19268
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 06/05/21 18:08

Il tuo lavoro è encomiabile Anthony.
Tuttavia come mi avevi anticipato il "gioco delle finestre" purtroppo non sempre riesce.
Ho provato più volte ma:
La finestra di IE rimane sempre in primo piano (doveva ridursi ad icona) e l'autorizzazione IE rimane nascosta (doveva balzare in primo piano)
L'aggiornamento non funziona (nonostante la cancellazione della cronologia da script)
La data appare in formato mm/gg/aaaa (non so perchè).
Alla luce dei fatti,mi sa che la prima soluzione che avevi proposto,quella di far chiudere IE alla fine del codice rimane la scelta migliore ed anche più...pratica (senza questi apri e chiudi continui che invece cercavo...)
Posso considerarmi decisamente appagato e ti ringrazio per il tempo che mi hai dedicato.
Adesso devo un attimo gestire un pò meglio i dati da importare.
Penso che ti disturberò ancora un pochino prossimamente.
Ciao e ancora grazie
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Importare dati Meteorologici Regione Marche

Postdi Anthony47 » 06/05/21 20:26

Vedo che ti stai rassegnando...
Quanto al formato data, purtroppo il 5/5 non era palese l'errore di conversione (nelle versioni precedenti la data rimaneva una stringa); per rimediare devi aggiungere in coda alla Function GimmeVal questa istruzione in questa posizione:
Codice: Seleziona tutto
'altre istruzioni
GimmeVal = Application.WorksheetFunction.Clean(Mid(InnerT, myPos + Len(ArrArr(I)(iInd)), UpTo - myPos - Len(ArrArr(I)(iInd))))
If IsDate(GimmeVal) Then GimmeVal = CDate(GimmeVal)           'AGGIUNGI QUESTA
End Function


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19268
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 07/05/21 10:19

Modifica effettuata:data OK
Resta il fatto che non aggiorna.
Rimango sulla versione con IE che si chiude.
Come hai intuito, il testo importato contiene caratteri spuri (CR, nel nostro caso); li elimino all'interno della nuova Function GimmeVal usando la WorksheetFunction.Clean

Volevo chiederti se puoi inserire l'istruzione in questo codice relativo alla versione che ho deciso adottare.
Come ti scrissi ho risolto con una formula ma se si elimina col codice credo sia meglio.

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("ReteMir")                 '<<< 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 18000
            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

   


Altra cosa,importando altre stazioni anche da altri siti ,mi ritrovo a volte a dover intervenire sulla data visualizzata per me in modo non consono.
Non riesco a risolvere questo:
Mi appare col formato aaaa-mm-gg hh:mm:ss
2021-05-07 10:14:00
ma vorrei che mi apparisse con
gg/mm/aaaa hh:mm

Anche per quest'altro non riesco a risolvere,mi appare:
Stazione Frontino, Pian dei Prati alt. m. 780 - Dati aggiornati il 06/05/21 alle ore 21.01
cerco di estrapolare solo il formato gg/mm/aaaa hh:mm
con
=SOSTITUISCI(STRINGA.ESTRAI(A1;67;23);" alle ore ";"")*1
ma ottengo un errore #VALORE!
dove sbaglio?
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Importare dati Meteorologici Regione Marche

Postdi Anthony47 » 07/05/21 10:51

La Function GimmeVal e' comune alle varie versioni di macro principale; quindi per ottenere il formato Data ti basta inserire l'istruzione If IsDate(GimmeVal) Then GimmeVal = CDate(GimmeVal) in coda al codice, subito prima di End Function

Non riesco a risolvere questo:
Mi appare col formato aaaa-mm-gg hh:mm:ss
2021-05-07 10:14:00
ma vorrei che mi apparisse con
gg/mm/aaaa hh:mm
Se il dato viene importato in formato "data" allora la formattazione la decidi tu, tramite il comando Formato celle. Puoi controllare se si tratta di "data" formattando la cella con un formato numerico con due decimali: se viene visualizzato come numero (es 44323,43) allora e' ragionevolmente una data.


Anche per quest'altro non riesco a risolvere,mi appare:
Stazione Frontino, Pian dei Prati alt. m. 780 - Dati aggiornati il 06/05/21 alle ore 21.01
cerco di estrapolare solo il formato gg/mm/aaaa hh:mm
con
Codice: Seleziona tutto
=SOSTITUISCI(STRINGA.ESTRAI(A1;67;23);" alle ore ";"")*1

ma ottengo un errore #VALORE!
Non so cosa hai fatto e cosa hai messo in A1...
Io se provo a leggere la stazione Frontino-721 ottengo dati pulitI:
Immagine

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19268
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 07/05/21 16:14

Se il dato viene importato in formato "data" allora la formattazione la decidi tu, tramite il comando Formato celle. Puoi controllare se si tratta di "data" formattando la cella con un formato numerico con due decimali: se viene visualizzato come numero (es 44323,43) allora e' ragionevolmente una data.


La stringa che importo da un sito è:
Stato Centralina: Online Aggiornamento: 2021-05-07 11:00:00
io la trasformo in :
2021-05-07 11:00:00
tramite
=SOSTITUISCI(EA107;"Stato Centralina: Online Aggiornamento:";)
tuttavia formattando la cella con formato numerico non cambia nulla :roll:

Non so cosa hai fatto e cosa hai messo in A1...
Io se provo a leggere la stazione Frontino-721 ottengo dati pulitI:

Non è questa la stazione cui mi riferisco,appartiene ad un'altra rete e si trova ad una quota diversa.
Forse bisogna utilizzare una formula diversa per estrarre la data...
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Importare dati Meteorologici Regione Marche

Postdi Anthony47 » 07/05/21 19:23

La funzione SOSTITUISCI lavora e restituisce una stringa; puoi formattarla Bold, Corsivo, etc ma non puoi formattarla “numero con due decimali”.
Puoi usare le funzioni DATA.VALORE e ORARIO.VALORE per ottenere dalla stringa una data + orario.
Esempio:
Codice: Seleziona tutto
=DATA.VALORE(SOSTITUISCI(A1;"Stato Centralina: Online Aggiornamento:";))+ORARIO.VALORE(SOSTITUISCI(A1;"Stato Centralina: Online Aggiornamento:";))


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19268
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 07/05/21 23:56

Ho provato ad utilizzare la formula con questa stringa che si trova in EY64 :
Stazione Frontino, Pian dei Prati alt. m. 780 - Dati aggiornati il 07/05/21 alle ore 19.49
immettendo:
Codice: Seleziona tutto
=DATA.VALORE(SOSTITUISCI(EY64;"Stazione Frontino, Pian dei Prati alt. m. 780 - Dati aggiornati il "));+ORARIO.VALORE(SOSTITUISCI(EY64;"Stazione Frontino, Pian dei Prati alt. m. 780 - Dati aggiornati il ";))


ma non so come mettere "alle ore"

Come cavolo è difficile
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Importare dati Meteorologici Regione Marche

Postdi Anthony47 » 08/05/21 12:33

Per migliorare la leggibilita' dei messaggi per favore inserisci il codice (formule o macro) tra i tag "Code": seleziona la parte che vuoi taggare, premi il pulsante "Code" che si trova in testa al box di scrittura dei messaggi.

Andando al quesito...
Intanto do per scontato che l'estrazione di data & ora dalla stringa Stato Centralina: Online Aggiornamento: 2021-05-07 11:00:00 sia stata risolta.

Ora hai una risposta del tipo Stazione Frontino, Pian dei Prati alt. m. 780 - Dati aggiornati il 07/05/21 alle ore 19.49
Potresti procedere ancora con la funzione SOSTITUISCI per eliminare prima uno spezzone e poi "alle ore", annidando due SOSTITUISCI.

Pero' questo ti porterebbe ad avere tante formule per ogni stazione che restituisce i risultati in quel modo. Meglio secondo me cercare la substringa "Dati aggiornati il", che servira' qualsiasi sia il nome della stazione. Poi dalla stringa così ottenuta (tipo 07/05/21 alle ore 19.49) elimini "alle ore" con sostituisci. Inoltre questo sito le ore le restituisce col separatore "punto" mentre a te credo che serva il "duepunti"; quindi dovrai pure fare questa sostituzione.
Insomma, tipo:
Codice: Seleziona tutto
=ANNULLA.SPAZI(SOSTITUISCI(SOSTITUISCI(STRINGA.ESTRAI(A1;TROVA("Dati aggiornati il";A1)+18;99);"alle ore";"");".";":"))
Avrai così una stringa "data & ora", che puoi trasformare in Data + Ora usando le funzioni DATA.VALORE e ORARIO.VALORE, come fatto con le formule precedenti.
Tuttavia la stringa ottenuta con questa formula e' piu' "pulita" rispetto a quella precedente; quindi probabilmente riuscirai ad avere il valore Data & Ora (gia' in formato Data & Orario) aggiugendo "*1" (senza le virgolette) in coda alla formula appena data, senza bisogno di passare per Data.Valore e Orario.Valore.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19268
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 09/05/21 16:57

Intanto do per scontato che l'estrazione di data & ora dalla stringa Stato Centralina: Online Aggiornamento: 2021-05-07 11:00:00 sia stata risolta.

Si avevo dimenticato di dirti che la cosa è andata a buon fine :)

Tuttavia la stringa ottenuta con questa formula e' piu' "pulita" rispetto a quella precedente; quindi probabilmente riuscirai ad avere il valore Data & Ora (gia' in formato Data & Orario) aggiugendo "*1" (senza le virgolette) in coda alla formula appena data, senza bisogno di passare per Data.Valore e Orario.Valore

Ed anche in questo caso la tua osservazione è risultata giusta:è bastato che aggungessi *1 per avere data ed ora formattati correttamente.
Sono una vera manna tutte queste formule (sapendo come applicarle).
Confesso di fare ancora fatica a capirne la sintassi per alcune...tuttavia non demordo! :lol:
L'organizzazione del mio foglio di lavoro procede...
Grazie ancora Anthony
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 15/05/21 23:26

HELP
Da stamattina non riesco più ad accedere alla rete MIR della regione marche con IE.
https://retemir.regione.marche.it
Quando lancio la macro mi ci vuole una vita per far apparire la finestra relativa all'errore di certificato.
Poi continua a caricare e non la smette più
Capita anche a te Anthony?
Nessun problema con Firefox.
:roll:
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Importare dati Meteorologici Regione Marche

Postdi Anthony47 » 16/05/21 01:12

A me funziona come sempre: fa il login e legge le stazioni alla solita velocita'. Hai gia' provato riavviando il pc?
Avatar utente
Anthony47
Moderatore
 
Post: 19268
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 16/05/21 11:11

Si avevo riavviato pure.
Che cosa strana,adesso funge regolarmente.
Avevo provato anche da un altro pc ed il problema me lo dava solo con IE mentre con Firefox andava come un fulmine.
Boh!
Grazie Anthony
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "Importare dati Meteorologici Regione Marche":


Chi c’è in linea

Visitano il forum: Nessuno e 38 ospiti