A proposito della Sub GetAllTablesLE che mi hai dato qui
- Codice: Seleziona tutto
Dim WPage As Object
Sub GetAllTablesLE(myUrl As String, Optional rNum0 As Long = 1, Optional cNum0 As Long = 1)
Dim TBColl As Object, StrHtm As String
Dim I As Long, J As Long, myTim As Single
Dim RNum As Long, CNum As Long, HTDoc As Object
Dim iniTab As Long, finiTab As Long
'Dim TArr
Dim TDColl As Object, TRColl As Object, AColl As Object ', PiPPo As Long
If WPage Is Nothing Then
Set WPage = CreateObject("Selenium.CHRomedriver")
End If
'''On Error Resume Next
reUrl:
WPage.Get myUrl
'
'Carica e ricarica...
'If myUrl <> WPage.URL And PiPPo < 4 Then
' PiPPo = PiPPo + 1
' Debug.Print "Non pronta", PiPPo, myUrl, WPage.URL
' GoTo reUrl
'End If
'Debug.Print "Pagina pronta", PiPPo, myUrl, WPage.URL
'myTim = Timer
'
'Set HTDoc = CreateObject("HTMLfile") 'late binding alla html obj lib
'
'Crea htmlDocument:
HTDoc.Open
lenhtml = Len(WPage.PageSource)
Do
iniTab = InStr(finiTab + 1, WPage.PageSource, "<table", vbTextCompare)
finiTab = InStr(iniTab + 1, WPage.PageSource, "</table", vbTextCompare)
If iniTab = 0 Then Exit Do
StrHtm = StrHtm & Mid(WPage.PageSource, iniTab, finiTab - iniTab + 10)
Loop
HTDoc.write StrHtm
'
'esamina i tag tabella/riga/dati:
If Not HTDoc Is Nothing Then
Set TBColl = HTDoc.getElementsByTagName("table")
RNum = rNum0: CNum = cNum0
For I = 0 To TBColl.Length - 1
RNum = RNum + 1
Cells(RNum, CNum).Value = "## Table " & I
Debug.Print "## Table " & I, Format(Timer - myTim, "0.0"), RNum
Set TRColl = TBColl(I).getElementsByTagName("tr")
RNum = RNum + 1: CNum = cNum0
For J = 0 To TRColl.Length - 1
Set TDColl = TRColl(J).getElementsByTagName("td")
For K = 0 To TDColl.Length - 1
Cells(RNum, CNum).Value = TDColl(K).innertext
Set AColl = TDColl(K).getElementsByTagName("a")
If AColl.Length > 0 Then
ActiveSheet.Hyperlinks.Add anchor:=Cells(RNum, CNum), _
Address:=AColl(0).href
End If
CNum = CNum + 1
Next K
RNum = RNum + 1: CNum = cNum0
' Debug.Print "## Table " & I, Format(Timer - myTim, "0.0"), RNum
Next J
RNum = RNum + 1
DoEvents
Next I
End If
Debug.Print "FINE-XA", RNum, Format(Timer - myTim, "0.00"), myUrl
End Sub
, la sto provando per importarmi il palinsesto del tennis dal sito https://www.betexplorer.com/next/tennis/?year=2022&month=04&day=28.
Purtroppo, nel sito BMB non funziona niente, perchè le pagine non si aprono o gli url cambiano. Allora sto provando a passare a betexplorer, anche se non è la stessa cosa.
Però forse c'è qualcosa da cambiare? Perchè a me gli hyperlink non li importa (e io avevo chiesto questo codice, proprio per averli). Qualche scritta si colora di blu. Ma gli hyperlink non ci sono.
Non ho cambiato niente. Ho solo spento il codice di PiPPo, che non credo sia utile in questo caso.