Web Src Link

[Baggwell]

Merhaba,

https://m.ebay.com/sch/Cell-Phones-Smartphones-/9355/i.html?epp=24&isRefine=true&itemId=0

İlgili linkteki resim linklerini excele getirebilir miyiz?

Teşekkürler

 

[halit3]

Bu kodu bir dene

Sub veri20()
Dim URL As String
Dim IE As Object

Range("A1:A500").ClearContents
ReDim veri(6500)

sat = 1
say = 1

URL = "https://www.ebay.com/sch/Cell-Phones-Smartphones-/9355/i.html?epp=24&isRefine=true&itemId=0"
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate URL
.Visible = True
.Width = 300
.Height = 400
.Left = 50

Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

On Error Resume Next

Set objInputs = IE.document.getElementsByTagName("*")

For Each nesne In objInputs
deg1 = Split(nesne.src, "jpg")
If UBound(deg1) > 0 Then
veri(sat) = nesne.src
sat = sat + 1
End If
Next nesne
IE.Quit: Set IE = Nothing
End With


For k = 1 To sat
If Len(Trim(veri(k))) > 10 Then

Cells(say, 1) = veri(k)
say = say + 1
End If

Next k


MsgBox ("Bitti  ")
End Sub

 

[halit3]

Bu kod ondan daha iyi gibi geldi bana

Sub veri20()
Dim URL As String
Dim IE As Object

Range("A1:A5000").ClearContents

say = 1

URL = "https://www.ebay.com/sch/Cell-Phones-Smartphones-/9355/i.html?epp=24&isRefine=true&itemId=0"
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate URL
.Visible = True
.Width = 300
.Height = 400
.Left = 50
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

Set botoes = IE.document.getElementsByTagName("img")
For Each bt In botoes
If Right(bt.src, 3) = "jpg" Then
say = say + 1
Cells(say, 1) = bt.src
End If
Next
IE.Quit: Set IE = Nothing
End With


MsgBox ("Bitti  ")
End Sub

 

[Baggwell]

Elinize sağlık, özellikle ikinci format çok güzel olmuş teşekkürler