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

Importare dati Meteorologici Regione Marche

Postdi Paolo67 » 20/04/21 21:12

Ciao a tutti,
ho excel 2003 e riesco ad importare con la query web:
Dati ----->Importa dati esterni ----->Nuova Query web...
alcuni dati numerici da alcuni siti web in alcune celle del foglio di calcolo.
Purtroppo questa operazione non mi riesce con un sito in particolare, provocandomi improvvisamente la chiusura di excel.
Io imposto normalmente la query:
mi si apre la finestrella,
vado a digitare l'url
In questa fase mi escono diverse volte finestrelle di errore nello script,io rispondo sempre NO (ma anche dicendo SI non cambia niente...)
mi viene caricata la pagina,
localizzo la tabella di interesse,
clicco sulla freccetta gialla
A questo punto clicco su importa e...mi crasha excel!
Il link problematico è questo:
http://www.lineameteo.it/stazioni.php?id=2009
dove 2009 indica la stazione dalla quale mi interessa importare alcuni dati.
Come posso risolvere la cosa?
grazie
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Sponsor
 

Re: Query web...con un sito mi si chiude excel

Postdi Anthony47 » 21/04/21 11:58

Intanto "Benvenuto nel forum"

Come e' noto le web query non sono in grado di lavorare su pagine compilate con script; si puo' provare con l'accesso diretto alla pagina e poi la lettura dei suoi tag, con un gioco di tempo e di pazienza.
Purtroppo al primo contatto l'impostazione del sito e' risultata alquanto articolata (il fornitore originale dei dati e' https://retemeteo.lineameteo.it/index.php) ma la sua presentazione e' fatta tramite un paio di "iframe" annidati che (con la prima dose di tempo e di pazienza) non ho ancora decodificato.

Ci provero' ancora e ti aggiorno

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

Re: Query web...con un sito mi si chiude excel

Postdi Paolo67 » 21/04/21 12:45

Ciao Anthony,
grazie per la risposta celere e la disponibilità.
Aspetto a questo punto con impazienza tue notizie.
Buona giornata

PS: i dati ufficiali sono forniti da
https://retemir.regione.marche.it/login#
ovviamente ho le credenziali di accesso se può servirti...
Il link diretto alla stazione in questo caso è https://retemir.regione.marche.it/meteo ... odstaz=719
Non so se è più comodo percorrere quest'altra strada...
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Query web...con un sito mi si chiude excel

Postdi Paolo67 » 24/04/21 14:55

Anthony,risolto il problema con le icone in tabella (altro post),sei poi riuscito ad estrapolare qualcosa dalla pagina di questa stazione?
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Query web...con un sito mi si chiude excel

Postdi Anthony47 » 26/04/21 01:41

Niente, dopo un secondo lotto di tempo e di pazienza alzo bandiera bianca...

Ogni tentativo che conosco per accedere dall'url http://www.lineameteo.it/stazioni.php?id=2009 alle informazioni della stazione e' fallito; in genere mi esce "Autorizzazione negata" oppure un semplice "Forbidden".
Insomma si puo' leggere (forse) tutto meno le info che arrivano dalla stazione di MonteCarpegna (id=2009).

Credo sia legato alla protezione contro il "Cross-site scripting" (vedi su Wikipedia), e comunque non ho trovato un metodo per accedere alle informazioni

Sorry...
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query web...con un sito mi si chiude excel

Postdi Anthony47 » 26/04/21 11:35

Mi dava fastidio quella "bandiera bianca", e provando ho visto che quei dati non si fanno leggere ma si fanno scrivere in un file. Quindi, con un giro un po' lungo, si riusciranno a portare su excel.
Prima di procedere vorrei pero' essere certo di che cosa dobbiamo importare; fai quindi uno "screenshot" della pagina e su questa immagine indica che cosa bisogna importare.

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

Re: Query web...con un sito mi si chiude excel

Postdi Paolo67 » 26/04/21 15:16

Grande Anthony,
avendo letto il tuo primo msg relativo alla bandiera bianca...ahimè stavo valutando una seconda,ma credo più complicata alternativa da proporti.
Quest' ultima tua replica mi ha ridato gioia!
Ti allego lo screenshot.
i dati sono solo quelli cerchiati in rosso:
solo valore della temperatura (in questo caso +9.5°)
solo valore dell'umidità (in questo caso 53%)
e se si riesce...data ed ora del report
STOP
Ci sarebbe anche una 2° stazione che mi interesserebbe,però non so se poi si andrebbe complicando molto la cosa...
I valori da importare sarebbero sempre gli stessi:
solo valore della temperatura,
solo valore dell'umidità
se si riesce data ed ora del report
La stazione ha il link
http://www.lineameteo.it/stazioni.php?id=1976
Rimango in trepida attesa...
:)

Immagine
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Query web...con un sito mi si chiude excel

Postdi Anthony47 » 28/04/21 13:04

Allora…
Pubblico quanto ottenuto solo per curiosita', perche' il risultato e' notevolmente instabile.

Per cercare di "catturare" i dati della stazione, infatti, apro la pagina web tramite il browser di sistema e poi salvo su disco la pagina; ma questo non mi da' nessun controllo sul caricamento, sicche' nel codice ci sono dei tempi di attesa qua e là di parecchi secondi, sperando che siano sufficienti per le operazioni.
Inoltre il comportamento e' diverso sui vari browser; in particolare non funziona su Chrome e IE, mentre ha funzionato (con qualche comportamento instabile) su Firefox ed Edge. Per non aggiungere criticita' ai tempi di esecuzione e' meglio se il browser sia gia' aperto quando si lancera' la macro.

Infine dopo il lancio della macro il pc non deve essere toccato fino al completamento della stessa (cioe' fino a quando non sara' visualizzata nuovamente la finestra Excel); in questa fase sara' attivato il browser, verra' aperta la pagina web in una nuova scheda, si attende circa 8 secondi per dare tempo alla pagina di caricarsi, si attiva il comando Salva, si chiude la scheda del browser, si riattiva Excel. Ogni intervento da mouse o da tastiera e' da evitare.

Il codice comprende delle dichiarazioni iniziali, la Sub GetLineaMeteo (la macro da mandare in esecuzione) e la Sub GetStat
All'interno della Sub GetLineaMeteo va inserito il codice della stazione da importare; teoricamente quindi si possono importare i dati di piu' stazioni (basta inserire nella Sub GetLineaMeteo piu' istruzioni Call GetStat(NumeroStazione) ). Tuttavia il file deve includere un foglio che abbia il nome di ognuna delle stazioni, perche' ogni stazione importera' sul "suo" foglio la tabella con i dati in tempo reale.

Inoltre all'interno della Sub GetStat va dichiarato una directory di servizio in cui il contenuto della pagina web verra' salvato (vedi riga marcata <<<-1). La directory deve gia' esistere.
La macro raccoglie nel foglio dedicato alla stazione tutti i dati presenti nella tabella; l'utente puo' attingere alla tabella per portare sul suo schema le informazioni desiderate.

Il codice:

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

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
'
Set dSh = Sheets(StatID)
dSh.Range("A:B").ClearContents
'
TmpFile = "C:\PROVA" & "\myStation.html"                    '<<<-1 Vedi Testo
'
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, vbNormalFocus)
If Result < 32 Then
    MsgBox "Errore in apertura Pagina web"
    Exit Sub
End If
Debug.Print Format(Now, "hh:mm:ss"), "Result=" & Result
Application.DisplayAlerts = False
'
Sleep 8000                                  '<<<-2 VEDI TESTO
Application.SendKeys "^s", True
Sleep 2000
skfile = TmpFile & "~"
Application.SendKeys skfile, True
Debug.Print Format(Now, "hh:mm:ss"), TmpFile
Sleep 3000
Application.SendKeys "^w"
Sleep 500
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
End Sub


Va messo in un "Modulo standard" del vba inizialmente vuoto (in modo che le "dichiarazioni" siano assolutamente in testa al Modulo)
Si modificano le istruzioni marcate <<< e <<<-1 (nome della stazione e Directory da usare per il salvataggio della pagina; se non funzionasse (pagina web non salvata o messaggio di errore) si puo' provare a modificare l'istruzione marcata <<<-2 (tempo di attesa prima di provare a salvare la pagina)

Nel caso che proprio non funzionasse la cosa non mi merevigliera'; posso come consolazione pubblicare il video del mio schermo mentre esegue fortunosamente le operazioni, ma il debug puo' solo essere fatto localmente e conuna certa difficolta'.

Buona fortuna a chi vorra' provare, quindi...
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query web...con un sito mi si chiude excel

Postdi Paolo67 » 28/04/21 17:40

Grazie Anthony,non sono a casa adesso per provare...
Non appena posso verifico il tutto e ti faccio sapere
:)
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Query web...con un sito mi si chiude excel

Postdi Paolo67 » 28/04/21 18:32

Eccomi:
Allora,vediamo se ho capito bene:
Ho creato un file excel chiamandolo TEST
In questo file ho rinominato il 1° foglio con 1976
Ho poi creato sull'HD una cartella in C col nome PROVA (come da tuo esempio e come da tua linea di codice):
TmpFile = "C:\PROVA" & "\myStation.html" '<<<-1 Vedi Testo
NON ho rinominato myStation.html
Ho lanciato Firefox
Ho lanciato la macro ma ho ottenuto questo errore:
:roll:

Immagine
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Query web...con un sito mi si chiude excel

Postdi Anthony47 » 28/04/21 18:54

E' sbagliata la posizione della macro, che deve andare in un "Modulo Standard" del vba (invece l'hai inserita in un "Modulo di Classe"; per una infarinatura vedi viewtopic.php?f=26&t=103893&p=647675#p647675)
Quindi, partendo dal modulo dove e' ora la macro:
-cancella tutto il codice
-Menu /Inserisci /Modulo; così avrai creato un "modulo standard"
-copia il codice e incollalo nel modulo appena creato

Per il resto mi pare che hai fatto bene.
Accertati anche che il tuo browser di default non sia Chrome, ma Edge oppure Firefox, e poi puoi provare.

Per associare la macro a qualche pulsante vedi viewtopic.php?f=26&t=103893&p=647678#p647678

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

Re: Query web...con un sito mi si chiude excel

Postdi Paolo67 » 28/04/21 19:00

Avevo sbagliato...non avevo copiato il codice nel modulo standard.
Adesso la macro parte ma mi da errore di percorso...
Non ho capito cosa sbaglio
Immagine
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Query web...con un sito mi si chiude excel

Postdi Anthony47 » 28/04/21 21:41

Quale browser usi? Alla fine della macro, la pagina web lineameteo.it era ancora aperta o non più?
Ripeti l'operazione, probabilmente avrai l'errore. Poi usando la ricerca di Windows, cerca dove e' stato salvato il file myStation.html (controlla che l'orario di creazione sia "adesso"), e se nella stessa directory esiste una cartella myStation_Files (idem controlla l'orario)

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

Re: Query web...con un sito mi si chiude excel

Postdi Paolo67 » 28/04/21 21:48

utilizzo Firefox.
La pagina web rimane aperta.
Il file non viene salvato (fatta ricerca con windows)
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Query web...con un sito mi si chiude excel

Postdi Anthony47 » 28/04/21 21:58

Ma e' aperta anche la finestra di Salva con nome? Se Sì, seguendo con attenzione lo schermo siamo certi che la finestra Salva con nome e' comparsa quando la pagina web si era completamente formata?
Il tuo Firefox e' in Italiano? Controlla che se premi Contr+s si apre la finestra Salva con nome.

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

Re: Query web...con un sito mi si chiude excel

Postdi Paolo67 » 28/04/21 22:03

No NON è aperta la finestra Salva con nome.
Il mio firefox è in italiano e se premo CTRL+s mi si apre "Salva con nome"
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Query web...con un sito mi si chiude excel

Postdi Anthony47 » 28/04/21 22:12

La macro l'hai copiata dal forum e incollata sul vba, giusto? (non l'hai riscritta).
Dopo che hai avviato la macro, sullo schermo dovresti vedere:
-firefox diventa la finestra attiva, la pagina web si assembla; dopo circa 8 secondi dall'avvio macro dovrebbe comparire la finestra Salva-con-nome; dopo 1 secondo la finestra dovrebbe scomparire e Firefox tornare in primo piano; dopo altri 1-2 sec Excel dovrebbe passare in primo piano e la scheda con la pagina web del meteo dovrebbe essere stata rimossa.

Tu che sequenza riesci a vedere?
E ricorda: guardare senza toccare
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query web...con un sito mi si chiude excel

Postdi Paolo67 » 28/04/21 22:21

Dopo aver avviato la macro vedo:
Che firefox diventa finestra attiva
la pagina web si assembla completamente in circa 3 max 4 sec.
La pagina rimane in primo piano e ci resta per tutto il tempo.
Dopo qualche secondo poi dopo in basso mi lampeggia l'icona di excel. Ci clicco su e mi esce il messaggio di errore.
la finestra salva con nome non compare mai!
OFFICE 2003 - OFFICE 2007
Paolo67
Utente Senior
 
Post: 121
Iscritto il: 20/04/21 20:35

Re: Query web...con un sito mi si chiude excel

Postdi Anthony47 » 28/04/21 22:23

Mi incolli il codice della macro? Copia dal modulo vba, incolla nel messaggio
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query web...con un sito mi si chiude excel

Postdi Paolo67 » 28/04/21 22:27

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

    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
    '
    Set dSh = Sheets(StatID)
    dSh.Range("A:B").ClearContents
    '
    TmpFile = "C:\PROVA" & "\myStation.html"                    '<<<-1 Vedi Testo
    '
    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, vbNormalFocus)
    If Result < 32 Then
        MsgBox "Errore in apertura Pagina web"
        Exit Sub
    End If
    Debug.Print Format(Now, "hh:mm:ss"), "Result=" & Result
    Application.DisplayAlerts = False
    '
    Sleep 8000                                  '<<<-2 VEDI TESTO
    Application.SendKeys "^s", True
    Sleep 2000
    skfile = TmpFile & "~"
    Application.SendKeys skfile, True
    Debug.Print Format(Now, "hh:mm:ss"), TmpFile
    Sleep 3000
    Application.SendKeys "^w"
    Sleep 500
    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
    End Sub


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

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Importare dati Meteorologici Regione Marche":


Chi c’è in linea

Visitano il forum: Nessuno e 40 ospiti