come capita spesso il sito cambia qualcosa e non funziona bene la macro,
in questa macro ho modificato input della data e va bene mentre con il tasto VAI non ci sono riuscito,
quindi ti chiedo gentilmente se potevi sistemarla, grazie
- Codice: Seleziona tutto
Dim IE As Object, myOk As Boolean '<<< Rigorosamente in testa al Modulo
Sub TabImport2()
'
Dim I As Long, J As Long, dArr(1 To 55)
Application.ScreenUpdating = False
Sheets("NewArchivio").Activate
'Range("Q2:BT50").ClearContents '<<< Azzera l'area dei risultati
'Range("R:BU").NumberFormat = "@"
For J = Range("A1") To Range("B1")
'For J = 2 To I - 1
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate "https://www.lottomaticaitalia.it/it/prodotti/lotto/estrazioni"
.Visible = True
Do While .Busy: DoEvents: Loop 'Attesa not busy
Do While .ReadyState <> 4: DoEvents: Loop 'Attesa documento
End With
'Compila date:
Set mycoll = IE.document.getelementsbytagname("input")
'mycoll(0).Click
mycoll(0).Value = Format(J, " dd/mm/yyyy")
Application.Wait (Now + TimeValue("0:00:03"))
mycoll(1).Click
Application.Wait (Now + TimeValue("0:00:02"))
' Cells(Rows.Count, "R").End(xlUp).Offset(2, 1).Value = dArr(J)
myOk = False
Call GetWTableCommon2(J)
If myOk Then Cells.Item(Rows.Count, 3).End(xlUp).Offset(0, -1) = Format(J, "dd/mm/yyyy")
Next J
'
IE.Quit
Set IE = Nothing
'Call Record
Range("A1").Select
MsgBox ("Completato...")
End Sub
Sub GetWTableCommon2(ByVal Dummy)
Dim myI As Long, myItm As Object, aAa, bBb, myJ As Long, TdTd, tRtR
'Application.ScreenUpdating = False
'Scaricare le tabelle:
Set mycoll = IE.document.getelementsbytagname("tbody")
'
myJ = 2 '17 '17=R-1
myI = Cells.Item(Rows.Count, myJ).End(xlUp).Row
mylbody = IE.document.getelementsbytagname("body")(0).innerText
If InStr(1, mylbody, " " & Format(Dummy, "d mmmm yyyy"), vbTextCompare) > 0 Then
For Each myItm In mycoll
For Each tRtR In myItm.getelementsbytagname("tr")
For Each TdTd In tRtR.getelementsbytagname("td")
If TdTd.classname = "center ng-binding ng-scope" Or TdTd.classname = "center ng-binding ng-scope blu" Then 'INSERIRE
'If TdTd.classname = "center ng-binding ng-scope" Then 'INSERIRE
'If TdTd.classname <> "ng-binding" Then 'If AGGIUNTO
Cells(myI + 1, myJ + 1) = TdTd.innerText
myJ = myJ + 1
End If
Next TdTd
' myI = myI + 1: myJ = 0
Next tRtR
' myI = myI + 1
Exit For
Next myItm
myOk = True
End If
'
'Range("B:BE").WrapText = False ' Adattare il range se <>R:BU
'< Fine importazione tabelle
'
'Stop
]
Sheets("NewArchivio")
In cella A1 01/04/2021
in cella B1 03/04/2021