con selenium vorrei copiare tutti i dati da una tabella web, allo scopo sto tentando di applicare la Caller di Anthony, la macro non mi da errore e si conclude correttamente però non scarica nulla. Secondo me è errata la riga di codice secondo la quale si dovrebbe copiare i dati su foglio excel . Nel debug con F8 viene saltata e non capisco quale errore ci sia .
Qui il codice :
- Codice: Seleziona tutto
Option Explicit
Dim web As Object
Sub Test()
Dim web As New ChromeDriver
Dim allTabs, j As Long, k As Long, L As Long, myHead As String, P As Long
Dim mTable As Selenium.WebElement
Dim tr As Selenium.WebElement
Dim td As Selenium.WebElement
Dim i As Integer
Dim Last1 As Long, LastA As Long
Dim MyUrl As String
Sheets("Isin").Activate
Sheets("Isin").Cells.ClearContents
'
With Sheets("Isin")
Range("A1:G1").Value = Array("Société émettrice", "Code ISIN", "Devise", "Coupon", "Montant minimal", "Maturité", "Prix sur le marché")
End With
Last1 = Cells(1, Columns.Count).End(xlToLeft).Column 'Quante colonne?
Dim bln As Boolean
bln = False
MyUrl = "https://www.xxxxxxx.com/bonds.php"
If web Is Nothing Then
Set web = CreateObject("Selenium.ChromeDriver")
web.Start "Chrome"
'Web.AddArgument ("--headless")
End If
With web
.Get MyUrl
' interruttore boleano e di attesa, la pagina web è agibile x modifiche.
bln = (MsgBox("Sicuro di voler continuare ?", vbYesNo) = vbYes) '
'=vbYes, in questo caso (si) Bln =true; con =vbNo si avrebbe Bln = false.
'Debug.Print bln
If bln = True Then
Dim Row As Integer
Row = 2
Set allTabs = web.FindElementsByXPath("//*[@id='content']/table")
allTabs = GimmeTablesArr(web, MyUrl) 'Ottieni la matrice delle tabelle
If Not IsEmpty(allTabs(2)) Then '<<< IF /END IF Aggiuntivo
For j = 1 To Last1 'Cerca l'intestazione di ogni colonna...
myHead = Cells(1, j).Value
For k = 1 To UBound(allTabs) '... in tutte le tabelle della pagina...
For L = 1 To UBound(allTabs(k)) '.... in tutte le righe di ogni tabella
'Se "Trovato" allora scrivi il valore:
If InStr(1, allTabs(k)(L, 1), myHead, vbTextCompare) = 1 Then
Cells(Row, j) = allTabs(k)(L, 2) '<<<<<<<<<<<< questa viene saltata <<<<<<<<<<<<<<<<<<<<<<<<
'.allTabs.AsTable.ToExcel Range("A2").Value
End If
Row = Row + 1
Next L
Next k
Next j
End If
' ActiveWindow.ScrollRow = i
'Next i
Else
Exit Sub
End If
End With
web.Close
web.Quit
' elimina righe con null o ""
Dim uREnd As Long, Y As Long
uREnd = Cells(Rows.Count, "A").End(xlUp).Row
For Y = uREnd To 2 Step -1
If Cells(Y, "A") = "" Then
Cells(Y, "A").EntireRow.Delete
End If
Next Y
Columns("A:H").EntireColumn.AutoFit
' aggiusta colonne
Range("A1").ColumnWidth = 40
Dim uR As Long
uR = Cells(Rows.Count, 1).End(xlUp).Row
Range("B1:H1").Select
Selection.ColumnWidth = 14
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' trova ultima
Range("B2:G" & uR).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
MsgBox "Lista Obbligazioni aggiornata", vbInformation, "Ok"
End Sub
Function GimmeTablesArr(lDriver As Object, MyUrl As String) As Variant
Dim PColl As WebElements, myItm As Object, TBColl As Object, pCount As Long
Dim i As Long, myTim As Single
Dim TArr()
'
With lDriver
On Error Resume Next
.Get MyUrl
Application.Wait (Now + TimeValue("00:00:02"))
On Error GoTo 0
myTim = Timer
Set TBColl = lDriver.FindElementsByTag("table")
If TBColl.Count > 0 Then i = TBColl.Count Else i = 1 'Aggiunta
ReDim TArr(1 To i)
'
For i = 1 To TBColl.Count
TArr(i) = TBColl(i).AsTable.Data
Next i
GimmeTablesArr = TArr
End With
Debug.Print "GTArr:", "Tables: " & i - 1, Format(Timer - myTim, "0.00"), MyUrl
End Function
