Mi è sopraggiunto un ulteriore problema ovvero con la macro, grazie a voi elaborata, scarico parte dei dati dalla Scheda di B.ita.na , che però non riporta la Scadenza del titolo. Ergo ho replicato la macro utilizzando una seconda origine dei dati : Dati completi , sia sul TLX che sul Mot, però la seconda macro (test2) non mi funziona ovvero non scarica l'unico dato che mi serve . Sbaglio metodo oppure ...
Allego file e codice .
- Codice: Seleziona tutto
Option Explicit
Public Sub Test2() '
Dim Html As Object
Dim CollA As Object
Dim N As Long, i As Integer
Dim dati As Variant
Dim dati1 As Variant
Dim intest As Variant, Intest2 As Variant
Dim MyIsin As String
Dim uR As Long
Dim R
Dim Ws1 As Worksheet
Set Ws1 = Sheets("Isin")
Ws1.Select
Ws1.Activate
Application.EnableEvents = False
' stessa intestazione + Scadenza del titolo
intest = Array("Isin", "Descrizione", "Ultimo", "Chiusura", "Variazione % ", "Valuta", "Lotto", "Cedola Periodale", "Cedola annua", "Rendimento a scadenza Lordo", "Rendimento a scadenza netto", _
"Rateo Lordo %", "Rateo Netto %", "Duration", "Mkt", "Scadenza")
Range("A1:P1") = intest
uR = Ws1.Cells(Rows.Count, 1).End(xlUp).Row
' Ws1.Range("B2:P" & uR).Clear
' codifica come stringa
Set Ws1 = Sheets("Isin")
Ws1.Select
Ws1.Activate
Application.EnableEvents = False
'
' codifica come stringa
With Ws1
.Range("C2:P" & uR).NumberFormat = "@"
' --------------converti isin a maiuscolo-------------------------------
Dim X As Object
For Each X In Range("A2:A" & uR)
X.Value = UCase(X.Value)
Next
'----------------------------------->>>>>>>>>>>>>>>>---------------------------
Set Html = CreateObject("htmlfile")
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
For N = 2 To uR
MyIsin = Cells(N, 1)
If MyIsin <> "" Then
'Provo su Mot >> Dati Completi
.Open "GET", "https://www.borsaitaliana.it/borsa/obbligazioni/mot/euro-obbligazioni/dati-completi.html?isin=" & Cells(N, 1) & " lang=it", False ' Mot
.send
Html.body.innerHTML = .responseText
Application.Wait Now + TimeValue("00:00:01") 'pausa di 1 secondi
Set CollA = Html.getElementsByClassName("t-text -right")
If Not CollA Is Nothing Then
If CollA.Length > 5 Then '+++
'trovato su Mot
'gestisci i dati da Mot
On Error Resume Next ' questo non è possibile toglierlo
dati1 = Array(0, 0, , , , , , , , , , , , , , , 25)
For i = 2 To 17
Cells(N, i) = CollA(dati1(i)).innerText
Next i
'On Error GoTo 0
'Debug.Print N, MyIsin, "Su Mot"
End If
End If
'Prova su TLx ?
If Cells(N, 15) <> "MOT" Then '.condizione per attivare la ricerca tlx.
.Open "GET", "https://www.borsaitaliana.it/borsa/obbligazioni/eurotlx/dati-completi.html?isin=" & Cells(N, 1) & "lang = it", False ' tlx"
.send
Html.body.innerHTML = .responseText
Application.Wait Now + TimeValue("00:00:01") 'pausa di 1 secondi
Set CollA = Nothing
'On Error Resume Next
Set CollA = Html.getElementsByClassName("t-text -right")
' On Error GoTo 0
If Not CollA Is Nothing Then
If CollA.Length > 5 Then '+++
'trovato su tlx
'gestisci i dati da tlx
'On Error Resume Next
dati = Array(, , , , , , , , , , , , , , 25)
For i = 2 To 17
Cells(N, i) = CollA(dati(i)).innerText
Next i
If Cells(N, 15) = "" Then
Cells(N, 15) = "TLX"
End If
On Error GoTo 0
'
'Debug.Print N, MyIsin, "Su Tlx"
End If '..
End If
End If
End If
Next N
End With
End With
' --------------------converte testo a numero--------------------------------
For Each R In Sheets("Isin").UsedRange.SpecialCells(xlCellTypeConstants)
If IsNumeric(R) Then
R.Value = CSng(R.Value)
R.NumberFormat = "0.00"
End If
Next
'
Range("C2:D" & uR).NumberFormat = "#,##0.00"
Range("F2:F" & uR).NumberFormat = "#,##"
End Sub
https://www.mediafire.com/file/k89whxi7 ... .xlsm/file
