Skúste jeden z týchto spôsobov:
Function NajdiLink(Artikel As String) As String
Dim httpRequest As New WinHttpRequest, oHTML As New HTMLDocument
Const URL$ = "https://www.sportisimo.sk/vyhladavanie/?hladany-vyraz="
With httpRequest
.Open "GET", URL & Artikel, False
.send 'Získanie HTML kódu
oHTML.body.innerHTML = .responseText 'Načítanie štruktúry stránky
On Error Resume Next
NajdiLink = oHTML.getElementsByClassName("Product_box")(0).getElementsByTagName("h3")(0).getElementsByTagName("a")(0).href 'Získanie odkazu na produkt
End With
End Function
Sub Hromadne()
Dim Linky() As String, Artikle(), R As Long, i As Long
Dim httpRequest As New WinHttpRequest, oHTML As New HTMLDocument
Const URL$ = "https://www.sportisimo.sk/vyhladavanie/?hladany-vyraz="
With ThisWorkbook.ActiveSheet
R = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If R = 0 Then MsgBox "Žiadne artikle", vbExclamation: Exit Sub
If R = 1 Then 'Načítanie artiklov
ReDim Artikle(1 To 1, 1 To 1): Artikle(1, 1) = .Cells(2, 1).Value
Else
Artikle = .Cells(2, 1).Resize(R).Value
End If
ReDim Linky(1 To R, 1 To 1)
For i = 1 To R
With httpRequest
.Open "GET", URL & Artikle(i, 1), False
.send 'Získanie HTML kódu
oHTML.body.innerHTML = .responseText 'Načítanie štruktúry stránky
On Error Resume Next
Linky(i, 1) = oHTML.getElementsByClassName("Product_box")(0).getElementsByTagName("h3")(0).getElementsByTagName("a")(0).href 'Získanie odkazu na produkt
On Error GoTo 0
End With
Next i
.Cells(2, 2).Resize(R).Value = Linky 'Zápis výsledných linkov
End With
End Sub
Function NajdiLink(Artikel As String) As String
Dim httpRequest As New WinHttpRequest, oHTML As New HTMLDocument
Const URL$ = "https://www.sportisimo.sk/vyhladavanie/?hladany-vyraz="
With httpRequest
.Open "GET", URL & Artikel, False
.send 'Získanie HTML kódu
oHTML.body.innerHTML = .responseText 'Načítanie štruktúry stránky
On Error Resume Next
NajdiLink = oHTML.getElementsByClassName("Product_box")(0).getElementsByTagName("h3")(0).getElementsByTagName("a")(0).href 'Získanie odkazu na produkt
End With
End Function
Sub Hromadne()
Dim Linky() As String, Artikle(), R As Long, i As Long
Dim httpRequest As New WinHttpRequest, oHTML As New HTMLDocument
Const URL$ = "https://www.sportisimo.sk/vyhladavanie/?hladany-vyraz="
With ThisWorkbook.ActiveSheet
R = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If R = 0 Then MsgBox "Žiadne artikle", vbExclamation: Exit Sub
If R = 1 Then 'Načítanie artiklov
ReDim Artikle(1 To 1, 1 To 1): Artikle(1, 1) = .Cells(2, 1).Value
Else
Artikle = .Cells(2, 1).Resize(R).Value
End If
ReDim Linky(1 To R, 1 To 1)
For i = 1 To R
With httpRequest
.Open "GET", URL & Artikle(i, 1), False
.send 'Získanie HTML kódu
oHTML.body.innerHTML = .responseText 'Načítanie štruktúry stránky
On Error Resume Next
Linky(i, 1) = oHTML.getElementsByClassName("Product_box")(0).getElementsByTagName("h3")(0).getElementsByTagName("a")(0).href 'Získanie odkazu na produkt
On Error GoTo 0
End With
Next i
.Cells(2, 2).Resize(R).Value = Linky 'Zápis výsledných linkov
End With
End Sub
Příloha: 
43536_url.zip (22kB, staženo 18x)
citovat43536_url.zip (22kB, staženo 18x)
RSS nejnovější články