Nuovo aggiornamento del sito ed il codice OLD-AGCOM non funziona più.
Premessa: non posso installare "Selenium" sù computer aziendali, W10 termina nel 2025 e IE (non più supportato da tempo), però funzionante ancora sul mio PC.
Ho provato con altri siti che visualizzo correttamente
(Ex https://it.wikipedia.org/wiki/Pagina_principale), invece sù
(https://datiroc.agcom.it/numerazionicallcenter) non visualizzo nulla (schermata bianca).Per cortesia potete controllare sul Vostro PC.
Come dovrò procedere in futuro? Desiderei una Vostra opinione in merito (non conosco altri metodi).
Ps. Mi sembra che l'ID della cella d'immissione numero si chiami "e-0" ???
- Codice: Seleziona tutto
Option Explicit
Sub Telefoni_Agcom()
Dim Ur As Long, x As Long, c As Long, Num As String
Dim ie As Object
Dim Doc As Object
Dim HTMLtr As Object
Dim HTMLTable As Object
Dim HTMLtd As Object
Dim HTMLTables As Object
Dim oHTML_Element As IHTMLElement
Const myURL As String = "https://datiroc.agcom.it/numerazionicallcenter"
'Const myURL As String = "https://it.wikipedia.org/wiki/Pagina_principale"
Ur = Range("F" & Rows.Count).End(xlUp).Row
Set ie = CreateObject("InternetExplorer.Application")
With ie
.navigate myURL
.Visible = True
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
End With
Set Doc = ie.document
'For x = 2 To Ur
c = 7
Num = "0682950305" 'Num = Cells(x, 6)
Doc.getElementById("e-0").Value = Num '<<<<ERRORE
For Each oHTML_Element In Doc.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For ' circa 10 Each
Next
''''''''''''''''''' Aggiunto perchè mi copiava il valore della ricerca precente
With ie
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
End With
Set Doc = ie.document
'''''''''''''''''
Set HTMLTables = Doc.getElementsByClassName("tab-telefonia-fissa")
For Each HTMLTable In HTMLTables ' qui salta se la ricerrca non da esito
For Each HTMLtr In HTMLTable.getElementsByTagName("tr")
For Each HTMLtd In HTMLtr.getElementsByTagName("td")
Cells(x, c) = HTMLtd.innerText
c = c + 1
Next HTMLtd
Next HTMLtr
Next HTMLTable
If Cells(x, 7) = "" Then Cells(x, 7) = "Non esiste"
'Next
ie.Quit
MsgBox "Finito" ', fatto in "
Set ie = Nothing
Set Doc = Nothing
End Sub
