Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Errore da link

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

Errore da link

Postdi Statix » 07/06/19 22:04

Ciao a tutti , ho un problema con questo link


https://www.lottomaticaitalia.it/del/es ... a=20190417

a volte funziona e a volte no, mi esce questa schermata di errore

Immagine

premetto che da anni non mi ha dato nessun problema,
non so se dipende dal sistema operativo windows 10 e office 2013 o dal server.
alcuni amici hanno lamentato lo stesso errore.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1227
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Sponsor
 

Re: Errore da link

Postdi Anthony47 » 08/06/19 22:53

Anche a me talvolta esce lo stesso errore.
Secondo me il sito non e' in grado di servire sempre tutte le richieste ricevute, e comunque non vedo cosa gli utenti possano fare per evitarlo...
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 16531
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Errore da link

Postdi Statix » 09/06/19 11:56

Ciao Anthony47,
ho questa webquery, vorrei fare in modo che se da errore,
vedi foto Immagine
ripete la webquery senza cliccare ogni volta su ok

Codice: Seleziona tutto
Sub Weba()
Dim I As Long
 Call Connessioni
 
Application.DisplayAlerts = False

 Range("B5:X310").ClearContents


I = Range("AA1")



    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://www.lottomaticaitalia.it/del/estrazioni-e-vincite/popup-pdf/estrazioni-giorno.html?data=" & I & "" _
        , Destination:=Range("$B$5"))
        '.CommandType = 0
        .Name = "estrazioni-giorno.html?data=" & I & ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False

          End With
        ' On Error Resume Next
         

    Application.DisplayAlerts = True
    Call Stampa
    Risposta = MsgBox("Aggiornamento effettuato")
   
    Range("A1").Select

End Sub
Sub Connessioni()
Dim M, C As Long


Sheets("Web").Select
For C = ActiveWorkbook.Connections.Count To 1 Step -1
    ActiveWorkbook.Connections(C).Delete
Next C

   For M = ActiveSheet.QueryTables.Count To 1 Step -1
    ActiveSheet.QueryTables(M).Delete
Next M
 
End Sub
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1227
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Errore da link

Postdi Anthony47 » 09/06/19 12:06

Se accedi al sito tramite webquery temo che devi convivere col problema.

Pero' potresti valutare di scaricare le tabelle del sito con una delle tante macro che accedono al sorgente pagina tramite IE; una delle ultime discussioni: viewtopic.php?f=26&t=110317&p=648133#p648148

Se decidi di usare quel metodo allora potremmo poi aggiungere al codice il controllo che l'importazione sia andata a buon fine, o eventualmente riprovare.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 16531
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Errore da link

Postdi Statix » 09/06/19 14:20

Ciao Anthony47,
ho letto il post e fatto piccole modifiche,
la macro sembra funzionare meglio, c'è solo da aggiungere un controllo dell' esatto aggiornamento,
cioè che tutto è andato a buon fine, altrimenti rilancia la macro.


Codice: Seleziona tutto
Sub CALL1()
    Sheets("Web").Select       '<<< Il foglio su cui si fara' l'importazione
   
    Range("A1:X400").ClearContents ' cancella dati
   
    I = 20190609     'Range("AA1")  in AA1 va messo anno mese giorno di ricerca esempio 20190609

    Call GetTabbbSub("https://www.lottomaticaitalia.it/del/estrazioni-e-vincite/popup-pdf/estrazioni-giorno.html?data=" & I & "")
    Application.ScreenUpdating = False

   
    Cells.WrapText = False
   
End Sub


Sub GetTabbbSub(ByVal myURL As String)

'Va Chiamata passandogli l'URL da leggere
'myURL = "https://www.lottomaticaitalia.it/del/estrazioni-e-vincite/popup-pdf/estrazioni-giorno.html?data=" & I & ""
 Application.ScreenUpdating = False

 Set IE = CreateObject("InternetExplorer.Application")
   
With IE
    .navigate myURL
    .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
Do
    DoEvents
    If Timer > myStart + 1 Or Timer < myStart Then Exit Do
Loop

'Leggi le tabelle SUL FOGLIO ATTIVO
 Application.ScreenUpdating = False

Set myColl = IE.document.getElementsByTagName("TABLE")
For Each myItm In myColl
    Cells(I + 1, 1) = "Table# " & ti + 1
    ti = ti + 1: I = I + 1
   
    For Each trtr In myItm.Rows
        For Each tdtd In trtr.Cells
            Cells(I + 1, j + 1) = tdtd.innerText
            j = j + 1
        Next tdtd
        I = I + 1: j = 0
DoEvents
    Next trtr

I = I + 1
Next myItm


'
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1227
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Errore da link

Postdi Anthony47 » 09/06/19 23:02

Il codice complessivo (da inserire in un Modulo standard Vuoto) diventa:
Codice: Seleziona tutto
Dim Esito As Boolean            'Rigorosamente in testa al Modulo

Sub CALL1()
Dim myC As Long

Sheets("Web").Select       '<<< Il foglio su cui si fara' l'importazione
   
I = 20190609     'Range("AA1")  in AA1 va messo anno mese giorno di ricerca esempio 20190609

Do
    Range("A1:X400").ClearContents ' cancella dati
    DoEvents
    Call GetTabbbSub("https://www.lottomaticaitalia.it/del/estrazioni-e-vincite/popup-pdf/estrazioni-giorno.html?data=" & I & "")
'    Application.ScreenUpdating = False
    If Esito Then Exit Do
    myC = myC + 1
    If myC > 10 Then Exit Do
Loop
    Cells.WrapText = False
End Sub


Sub GetTabbbSub(ByVal myURL As String)

'Va Chiamata passandogli l'URL da leggere
'myURL = "https://www.lottomaticaitalia.it/del/estrazioni-e-vincite/popup-pdf/estrazioni-giorno.html?data=" & I & ""
' Application.ScreenUpdating = False

 Set IE = CreateObject("InternetExplorer.Application")
   
With IE
    .navigate myURL
    .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
Do
    DoEvents
    If Timer > myStart + 1 Or Timer < myStart Then Exit Do
Loop

'Leggi le tabelle SUL FOGLIO ATTIVO
' Application.ScreenUpdating = False

Set myColl = IE.document.getElementsByTagName("TABLE")
For Each myItm In myColl
    Cells(I + 1, 1) = "Table# " & ti + 1
    ti = ti + 1: I = I + 1
   
    For Each trtr In myItm.Rows
        For Each tdtd In trtr.Cells
            Cells(I + 1, j + 1) = tdtd.innerText
            j = j + 1
        Next tdtd
        I = I + 1: j = 0
DoEvents
    Next trtr

I = I + 1
Next myItm
'
'Gestione esito:
If myColl.Length > 0 Then
    Esito = True
Else
    Esito = False
    Application.Wait (Now + TimeValue("0:00:03"))
End If
'
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub

Ci sono piccole modifiche qua e là, sia nella Sub CALL1 che nella Sub GetTabbbSub, mentre la variabile Esito, dichiarata in testa al Modulo, consente di comunicare tra le due parti

In caso di esito negativo ripete fino a 10 volte, prima di arrendersi.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 16531
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Errore da link

Postdi Statix » 10/06/19 20:39

Ciao Anthony47,
la macro va benissimo, manca solo un particolare,
nella web query c'è la possibilità di far eseguire in automatico il refresh period dell'estrazioni ogni minuto o 3 minuti dipende dall'impostazioni,
mentre adesso devo cliccare manualmente per aggiornare,
l'estrazione avviene ogni 5 minuti, quindi ogni 5- 6 minuti la macro dovrebbe andare in esecuzione.

Nota Bene per chi è interessato, dal sito lottomaticaitalia si puo scaricare solo l'ultimo anno rettroattivo
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1227
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Errore da link

Postdi Anthony47 » 11/06/19 22:22

La richiesta del refresh costringe e suggerisce varie modifiche nell'impostazione del codice.
La mia soluzione prevede la rivisitazione del codice gia' proposto (sia la Sub CALL che la Sub GetTabbbSub, che vanno sostituite in toto):
Codice: Seleziona tutto
Dim Esito As Boolean            'Rigorosamente in testa al Modulo

Sub CALL2()
Dim myC As Long, eSh As Worksheet

Set eSh = ThisWorkbook.Sheets("Web")       '<<< Il foglio su cui si fara' l'importazione

I = eSh.Range("AA1")   ' 20190609     'Range("AA1")  in AA1 va messo anno mese giorno di ricerca esempio 20190609
If eSh.Range("AA1") <> "" Then
    Do
        DoEvents
        Call GetTabbbSub("https://www.lottomaticaitalia.it/del/estrazioni-e-vincite/popup-pdf/estrazioni-giorno.html?data=" & I & "", eSh)
        If Esito Then Exit Do
        myC = myC + 1
        If myC > 2 Then Exit Do
    Loop
    eSh.Cells.WrapText = False
End If
If Esito Then
    eSh.Range("AA2") = Now + TimeValue("00:05:00")         'Ripeti lento
Else
    eSh.Range("AA2") = Now + TimeValue("00:01:00")         'Ripeti veloce
End If
Application.OnTime eSh.Range("AA2"), "CALL2"
End Sub


Sub GetTabbbSub(ByVal myURL As String, ByRef tSh As Worksheet)
'Va Chiamata passandogli l'URL da leggere E il foglio di destinazione dei dati
'myURL = "https://www.lottomaticaitalia.it/del/estrazioni-e-vincite/popup-pdf/estrazioni-giorno.html?data=" & I & ""
' Application.ScreenUpdating = False

 Set IE = CreateObject("InternetExplorer.Application")
   
With IE
    .navigate myURL
'    .Visible = True
    .Visible = False
''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
Do
    DoEvents
    If Timer > myStart + 0.5 Or Timer < myStart Then Exit Do
Loop

'Leggi le tabelle SUL FOGLIO ATTIVO
' Application.ScreenUpdating = False

Set mycoll = IE.document.getElementsByTagName("TABLE")
If mycoll.Length > 0 Then
tSh.Range("A1:X400").ClearContents ' cancella dati
    For Each myItm In mycoll
        tSh.Cells(I + 1, 1) = "Table# " & ti + 1
        ti = ti + 1: I = I + 1
       
        For Each tRTr In myItm.Rows
            For Each tdtd In tRTr.Cells
                tSh.Cells(I + 1, j + 1) = tdtd.innerText
                j = j + 1
                DoEvents
            Next tdtd
            I = I + 1: j = 0
    DoEvents
        Next tRTr
   
    I = I + 1
    Next myItm
    Esito = True
Else
    Esito = False
End If
'
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub



PIU' questa aggiunta da mettere nel modulo ThisWorkbook:
Codice: Seleziona tutto
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets("Web").Range("AA2").Value >= Now Then                               '<<<
'Beep
    Application.OnTime Sheets("Web").Range("AA2").Value, "CALL2", , False     '<<<
End If
End Sub

Le righe marcate <<< vanno personalizzate con le stesse informazioni inserite in Sub CALL2

Credo che non avrai difficolta' a decodificare le modifiche introdotte.

Operativamente, quando il file viene aperto va inserito il contenuto in AA1 e poi va lanciata la Sub CALL2.
Se il sito risponde correttamente la Call2 viene rischedulata dopo 5 minuti, usando il metodo OnTime; se invece l'esito e' stato negativo il nuovo scheduling e' dopo 1 minuto.

Quando il file viene chiuso si procede a cancellare le schedulazioni gia' impostate.
La macro usa la cella AA2 del foglio Web per memorizzare l'ora del "prossimo" scheduling

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 16531
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Errore da link

Postdi Statix » 18/06/19 20:48

Ciao Anthony47, la macro va abbastanza bene, però trovo un pò di difficolta con l'aggiornamento,

a volta i tempi non sono molti precisi, ti volevo chiedere se è possibile sincronizzare, l'orario con quello del pc,
per farti un esempio se l'orario è 15:32 l'unità è 2,
quindi dovrebbe partire la macro
quando l'unità dei minuti corrisponda o a 2 o a 7,

ho scaricato anche il file per il start stop reset. ma non riesco a metterlo in pratica.

quindi come prima cosa si deve sincronizzare l'orario con il pc , se l'unita è 2 o 7 allora parte la macro,
così si evita di lanciare la macro a vuoto. in genere i dati sono già pronti per aggiornare dopo 2 minuti
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1227
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Errore da link

Postdi Anthony47 » 19/06/19 19:45

Allora modifichiamo la Sub CALL2 in questo modo:
Codice: Seleziona tutto
Sub CALL2()
Dim myC As Long, eSh As Worksheet, tMin As Long
'
tMin = Minute(Now) Mod 10
Set eSh = ThisWorkbook.Sheets("Web")       '<<< Il foglio su cui si fara' l'importazione

If tMin = 2 Or tMin = 7 Or eSh.Range("AA3") = False Then
    'Popup:
    gloMess = "Avvio CALL2"
    tRTr = Shell("mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""" & gloMess & """,3,""Informazione:"",64))")
       
    I = eSh.Range("AA1")   ' 20190609     'Range("AA1")  in AA1 va messo anno mese giorno di ricerca esempio 20190609
    If eSh.Range("AA1") <> "" Then
        DoEvents
        Call GetTabbbSub("https://www.lottomaticaitalia.it/del/estrazioni-e-vincite/popup-pdf/estrazioni-giorno.html?data=" & I & "", eSh)
        eSh.Range("AA3") = Esito
        eSh.Cells.WrapText = False
    End If
End If
eSh.Range("AA2") = Now + TimeValue("00:01:00")

Application.OnTime eSh.Range("AA2"), "CALL2"
End Sub

In questo modo la query viene schedulata ogni minuto ma verra' eseguita solo ai minuti x2 e x7, oltre che quando "l'Esito" dell'ultima query era stata negativa
La macro usa le celle AA2 per memorizzare l'orario di prossima schedulazione e AA3 per memorizzare l'Esito

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 16531
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Errore da link

Postdi Statix » 20/06/19 21:11

Ciao Anthony47,
la macro è perfetta, ho sostituito i minuti x2 e x7
con x1 e x6 ,
in un minuto i dati sono già aggiornati.
grazie infinite.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1227
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta


Torna a Applicazioni Office Windows


Topic correlati a "Errore da link":

Errore 0.000000d
Autore: Eiannece
Forum: Software Windows
Risposte: 0

Chi c’è in linea

Visitano il forum: Nessuno e 19 ospiti

cron