Buonasera,
In un sito, risulta imposssibile fare data query in quanto appena si apre la pagina, dà questo errore e impalla excel, esistono rimedi?
Moderatori: Anthony47, Flash30005
Public IE As Object
Sub GetTabbbSub(ByVal myURL As String)
'Va Chiamata passandogli l'URL da leggere
''' Set IE = CreateObject("InternetExplorer.Application") 'NO, lo facciamo nella macro principale
With IE
.navigate myURL
.Visible = True
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 + 2 Or Timer < myStart Then Exit Do
Loop
'''ESCE SE HO CHIAMATO LA PAGINA DI LOGIN:
If myURL = "https://www.easyinfogas.it/" Then Exit Sub
'Leggi le tabelle SUL FOGLIO ATTIVO
''Sheets("Classifica Home").Select
''Cells.Clear
Set mycoll = IE.document.getElementsByTagName("TABLE")
For Each myItm In mycoll
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
Next trtr
i = i + 1
Next myItm
''Stop 'Vedi testo
'''Chiusura IE 'NO, anche questo lo facciamo nella macro principale
'''IE.Quit
'''Set IE = Nothing
End Sub
Sub Principale()
Set IE = CreateObject("InternetExplorer.Application")
Sheets("FoglioSuCuiFareL'Importazione").Select
Cells.ClearContents
Call GetTabbbSub("https://www.easyinfogas.it/") 'Chiamo la pagina iniziale e mi loggo a mano
Stop
Call GetTabbbSub("https://www.easyinfogas.it/L'URL-DA-CUI-IMPORTARE-LE-TABELLE") 'Chiamo la pagina con le tabelle
Stop 'SOLO PER TEST, POI CANCELLALO
IE.Quit
Set IE = Nothing
End Sub
Public IE As Object
Sub GetTabbbSub(ByVal myURL As String)
'Va Chiamata passandogli l'URL da leggere
''' Set IE = CreateObject("InternetExplorer.Application") 'NO, lo facciamo nella macro principale
With IE
.navigate myURL
.Visible = True
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 + 2 Or Timer < myStart Then Exit Do
Loop
'''ESCE SE HO CHIAMATO LA PAGINA DI LOGIN:
If myURL = "https://www.easyinfogas.it/" Then Exit Sub
'Leggi le tabelle SUL FOGLIO ATTIVO
''Sheets("Classifica Home").Select
''Cells.Clear
Set mycoll = IE.document.getElementsByTagName("TABLE")
For Each myItm In mycoll
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
Next trtr
i = i + 1
Next myItm
''Stop 'Vedi testo
'''Chiusura IE 'NO, anche questo lo facciamo nella macro principale
'''IE.Quit
'''Set IE = Nothing
End Sub
Sub Principale()
Set IE = CreateObject("InternetExplorer.Application")
Sheets("[b]Foglio2[/b]").Select
Cells.ClearContents
Call GetTabbbSub("[b]https://www.easyinfogas.it/[/b]") 'Chiamo la pagina iniziale e mi loggo a mano
Stop
Call GetTabbbSub("[b]https://www.easyinfogas.it/reader_mod.php?id=3765[/b]") 'Chiamo la pagina con le tabelle
Stop 'SOLO PER TEST, POI CANCELLALO
IE.Quit
Set IE = Nothing
End Sub
Sub Principale()
Set IE = CreateObject("InternetExplorer.Application")
Sheets("Foglio1").Select
Cells.ClearContents
Call GetTabbbSub("https://www.corriere.it/") 'Chiamo la pagina iniziale e mi loggo a mano
Stop
Call GetTabbbSub("https://borsa.corriere.it/borsa-italiana/azioni/listino-completo?topicGroupIndex=A") 'Chiamo la pagina con le tabelle
Stop 'SOLO PER TEST, POI CANCELLALO
IE.Quit
Set IE = Nothing
End Sub
Sub GetTabbbSub(ByVal myURL As String)
'Va Chiamata passandogli l'URL da leggere
''' Set IE = CreateObject("InternetExplorer.Application") 'NO, lo facciamo nella macro principale
With IE
.navigate myURL
.Visible = True
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 + 2 Or Timer < myStart Then Exit Do
Loop
'''ESCE SE HO CHIAMATO LA PAGINA DI LOGIN:
If myURL = "https://www.easyinfogas.it/" Then Exit Sub
'Leggi i dati (alla cieca):
''Sheets("Classifica Home").Select
''Cells.Clear
Dim my2Coll As Object
Set mycoll = IE.document.getElementsByClassName("dataContent")
Set my2Coll = mycoll(0).getElementsByClassName("clmn box1")
Cells(2, 1) = my2Coll(0).getElementsByClassName("intStrng title")(0).innerText
Cells(2, 2) = my2Coll(0).getElementsByClassName("intStrng")(0).innerText
Cells(2, 3) = my2Coll(0).getElementsByClassName("intStrng")(1).innerText
Set my2Coll = mycoll(0).getElementsByClassName("clmn box2")
Cells(2, 4) = my2Coll(0).getElementsByClassName("intStrng")(0).innerText
Cells(2, 5) = my2Coll(0).getElementsByClassName("intStrng")(1).innerText
''Stop 'Vedi testo
'''Chiusura IE 'NO, anche questo lo facciamo nella macro principale
'''IE.Quit
'''Set IE = Nothing
End Sub
Public IE As Object
Sub GetTabbbXyl()
Dim ESh As Worksheet, LSh As Worksheet, I As Long
Dim my2Coll As Object, myColl As Object
'
Set ESh = Sheets("Estrazioni") '<<< Il foglio dei risultati
Set LSh = Sheets("Link") '<<< Il foglio con i LINK
'
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
ESh.Cells.ClearContents '!!! AZZERA foglio dei risultati
'
For I = 1 To LSh.Cells(Rows.Count, 1).End(xlUp).Row
myURL = LSh.Cells(I, 1)
With IE
.navigate myURL
.Visible = True
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
'
'''ESCE SE DEVO FARE LOGIN:
If IE.LOCATIONUrL = "https://www.easyinfogas.it/index.php" Then
MsgBox ("Eseguire il Login e rilanciare la macro")
Exit Sub
End If
'
'Leggi i dati (alla cieca):
Set myColl = IE.document.getElementsByClassName("dataContent")
Set my2Coll = myColl(0).getElementsByClassName("clmn box1")
Cells(I + 1, 1) = Replace(myURL, "https://www.easyinfogas.it/reader_mod.php?", "", , , vbTextCompare)
Cells(I + 1, 2) = my2Coll(0).getElementsByClassName("intStrng title")(0).innerText
Cells(I + 1, 3) = my2Coll(0).getElementsByClassName("intStrng")(0).innerText
Cells(I + 1, 4) = my2Coll(0).getElementsByClassName("intStrng")(1).innerText
Cells(I + 1, 5) = my2Coll(0).getElementsByClassName("intStrng")(2).innerText
'secondo gruppo
Set my2Coll = myColl(0).getElementsByClassName("clmn box2")
Cells(I + 1, 6) = my2Coll(0).getElementsByClassName("intStrng")(0).innerText
Cells(I + 1, 7) = my2Coll(0).getElementsByClassName("intStrng")(2).innerText
Next I
'
'Stop 'Vedi testo
'''Chiusura IE
IE.Quit
Set IE = Nothing
End Sub
If Timer > myStart + 0.3 Or Timer < myStart Then Exit Do
Public IE As Object
Sub EstraiID()
Dim ESh As Worksheet, LSh As Worksheet, i As Long
Dim my2Coll As Object, myColl As Object
'
Set ESh = Sheets("Estrazioni")
Set LSh = Sheets("Link")
'
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
Range("A2:S18001").Select
Selection.ClearContents
'
For i = 2 To LSh.Cells(Rows.Count, 1).End(xlUp).Row
myURL = LSh.Cells(i, 1)
With IE
.navigate myURL
.Visible = True
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
End With
'
myStart = Timer
Do
DoEvents
If Timer > myStart + 1 Or Timer < myStart Then Exit Do
Loop
'
If IE.LOCATIONUrL = "https://www.easyinfogas.it/index.php" Then
MsgBox ("Eseguire il Login e rilanciare la macro")
Exit Sub
End If
'
Set myColl = IE.document.getElementsByClassName("dataContent")
Set my2Coll = myColl(0).getElementsByClassName("clmn box1")
Cells(i + 0, 1) = Replace(myURL, "https://www.easyinfogas.it/reader_mod.php?id=", "", , , vbTextCompare) 'ID
Cells(i + 0, 2) = my2Coll(0).getElementsByClassName("intStrng")(0).innertext 'PDR
Cells(i + 0, 3) = my2Coll(0).getElementsByClassName("intStrng")(1).innertext 'Cod. Cliente
Cells(i + 0, 4) = my2Coll(0).getElementsByClassName("intStrng")(2).innertext 'Matricola
Cells(i + 0, 9) = my2Coll(0).getElementsByClassName("intfield")(0).innertext 'Note
Cells(i + 0, 12) = my2Coll(0).getElementsByClassName("lastModify")(0).innertext 'Ultima Modifica
Cells(i + 0, 14) = my2Coll(0).getElementsByClassName("intStrngTitle")(2).innertext 'Utente
Cells(i + 0, 15) = my2Coll(0).getElementsByClassName("intStrngDesc")(0).innertext 'Zona
Cells(i + 0, 16) = my2Coll(0).getElementsByClassName("intStrngDesc")(1).innertext 'Indirizzo
Cells(i + 0, 17) = my2Coll(0).getElementsByClassName("intStrngDesc")(2).innertext 'Interno
Cells(i + 0, 18) = my2Coll(0).getElementsByClassName("intStrngDesc")(3).innertext 'Posizione
Cells(i + 0, 19) = my2Coll(0).getElementsByClassName("intStrng")(3).innertext 'Telefono '<<<<<-------
Set my2Coll = myColl(0).getElementsByClassName("clmn box2")
Cells(i + 0, 5) = my2Coll(0).getElementsByClassName("intStrng")(1).innertext 'Data Ultima Lettura
Cells(i + 0, 7) = my2Coll(0).getElementsByClassName("selectLong")(0).innertext 'Stato Lettura
Cells(i + 0, 8) = my2Coll(0).getElementsByClassName("intfield inline")(0).innerhtml 'Cartolina
Cells(i + 0, 10) = my2Coll(0).getElementsByClassName("intStrng")(2).innertext 'Data Lettura Attuale
Cells(i + 0, 6) = my2Coll(0).getElementsByClassName("intStrng")(0).innertext 'Lettura Precedente
Cells(i + 0, 11) = my2Coll(0).getElementsByClassName("intfield")(0).innerhtml 'Lettura Attuale
Cells(i + 0, 13) = my2Coll(0).getElementsByClassName("file-wrapper")(0).innertext 'Immagine
Next i
IE.Quit
Set IE = Nothing
End Sub
On Error Resume Next
Cells(i + 0, 19) = my2Coll(0).getElementsByClassName("intStrng")(3).innertext 'Telefono
On Error GoTo 0
Torna a Applicazioni Office Windows
"Spegnere" il riconoscimento data. Autore: aggittoriu |
Forum: Applicazioni Office Windows Risposte: 2 |
Supporto per Macro Query import pdf to excel Autore: JanVathek |
Forum: Applicazioni Office Windows Risposte: 10 |
Impossibile accedere a determinati siti web Autore: wallace&gromit |
Forum: Software Windows Risposte: 3 |
WIN10 Impossibile accedere - Riavvio continuo Autore: Andrea83pc |
Forum: Sistemi Operativi Windows Risposte: 2 |
Visitano il forum: Nessuno e 14 ospiti