< návrat zpět

MS Excel


Téma: Nájsť artikel na webe a získať hiperlink ? rss

Zaslal/a 10.6.2019 13:48

Ahojte.

Vedel by mi prosím niekto pomôcť ?

Potrebujem makro, ktoré by vyhľadalo artikel produktu v stĺpci "A" na konkrétnom webe vo vyhľadávacom poli a URL nájdeného produktu vypísalo do stĺpca "B".

Artikel potrebujem vyhľadať tu:
https://www.sportisimo.sk/vyhladavanie/?hladany-vyraz=

Pokúšal som sa upraviť kód na vyhľadanie QR kódu, ale nefunguje mi to.
Príde mi to ako rovnaká procedúra, len sa nevyhľadá QR kód ale URL.
Neviem to upraviť tak aby mi to fungovalo 7

V priloženom súbore je makro na ten QR kód.

Ďakujem za pomoc.

Příloha: zip43504_url.zip (18kB, staženo 1x)
Zaslat odpověď >

#043536
elninoslov
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
Příloha: zip43536_url.zip (22kB, staženo 4x)
citovat
#043540
elninoslov
Inak tú istú tému ste založil 2.6.2019 a potom túto 10.6.2019. To sa nerobí !citovat
#043546
avatar

elninoslov napsal/a:



Veľmi pekne Vám ďakujem. Funguje to perfektne.
Nemáte prosím nejaké linky, alebo materiály na základy VBA v exceli ?

PS.: za duplicitnú tému sa ospravedlňujem, už sa to nestane.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura III

Oblíbený formulář Faktura byl vylepšen a rozšířen. Formulář faktura III
Více se dočtete zde.

Aktivní diskuse

text > číslo=PRAVDA

Rejpal • 26.6. 20:29

text > číslo=PRAVDA

pavelo • 26.6. 14:35

vlookup

Stalker • 24.6. 13:17

vlookup

simplynever • 24.6. 10:42

vlookup

Rejpal • 24.6. 10:19

vlookup

simplynever • 24.6. 8:16

Pocet dni bez sviatkov

quiter • 23.6. 20:56