la prima parte dei link è simile a questa:
https://www.xxxxxx.it/borsa/obbligazioni/mot/obbligazioni-in-euro/dati-completi.html?isin=& myIsin&lang=it
il myIsin deriva dal foglio Dati dove sono elencati in colonna da A2 gli sin stessi .
- Codice: Seleziona tutto
Option Explicit
Sub OpenHyperLinks()
Dim Sh As Worksheet
Dim xHyperlink As Hyperlink
Dim WorkRng As Range
Dim Rng As Range
Set Sh = Worksheets("url")
With Sh
Set Rng = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With
On Error Resume Next
'Set WorkRng = Application.Selection
For Each xHyperlink In Rng.Hyperlinks
xHyperlink.Follow
Next
MsgBox ("Finito !")
End Sub
- Codice: Seleziona tutto
Option Explicit
Sub Aggiorna()
Dim Wpage As New Selenium.ChromeDriver
Dim Element As Selenium.WebElement
Dim r As Long, c As Integer
Dim myIsin As String, LastR As Long, i As Long, LastC As Long
Dim iTables As Selenium.WebElements
Dim AllTabs, J As Long, K As Long, L As Long, myHead As String, P As Long
' Dim Nome As Selenium.WebElement
'Dim uR As Long
Dim Wks As Worksheet, Wks1 As Worksheet
'Dim indirizzo As String
Dim Destinazione As String ' N_foglio As String
Dim myUrl As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Wks = Worksheets("url")
Set Wks1 = Worksheets("Dati")
LastR = Wks1.Cells(Rows.Count, "A").End(xlUp).Row 'Quanti Isin?
LastC = Wks1.Cells(1, Columns.Count).End(xlToLeft).Column 'Quante colonne?
'
Wks1.Range("B2").Resize(LastR + 10, LastC + 5).ClearContents
'Crea Driver:
If Wpage Is Nothing Then
Set Wpage = CreateObject("Selenium.ChromeDriver")
Wpage.Start "Chrome"
Wpage.AddArgument ("--headless")
End If
With Wpage
Dim indirizzo As Hyperlink
For i = 2 To LastR
myIsin = Wks1.Range("A" & i)
indirizzo = Wks.Range("D" & i) & myIsin
' Sheets.Add After:=Sheets(Sheets.Count)
'ActiveSheet.Name = N_foglio
' .Wait 5000
.get indirizzo
If .FindElementsByCss("table").Count > 0 Then
Set iTables = .FindElementsByCss("table")
For Each Element In driver.FindElementsByCss("table") '
'se l'elemento è diverso da Vuoto o da spazio
AllTabs = GimmeTablesArr(Wpage, myUrl) 'Ottieni la matrice delle tabelle
If Not IsEmpty(AllTabs(1)) Then '<<< IF /END IF Aggiuntivo
For J = 2 To LastC '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
If Cells(i, J) = "" Then Cells(i, J) = AllTabs(K)(L, 2)
End If
Next L
Next K
Next J
End If
Next
End If
Next i
End With
'Quit Selenium
'.Close
'wpage.Quit
'allinea a dx
Range("A" & LastR & LastC).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Set Wpage = Nothing
MsgBox ("Informazioni raccolte...")
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
'.Get myUrl
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
