Excel'de Siteden resim URL'si çekmek

[Tevfik_Kursun]

Merhaba Sayın Hocalarım,
A sütununa GoogleDrive 'daki resim dosyalarının bulunduğu adresleri yazılı. B sütununa bu dosyaları çağırabilecek linkleri yazdırmak istiyorum. Yukarıdaki makroları ayrı ayrı uyguladım. Başarılı olamadım. Yardımlarınızı rica ediyorum.
Saygılarımla

 

[Haluk]

Tevfik Bey, konu hakkında bir fikrim yok ama, bu işi neden Google Sheets ile yapmıyorsunuz ? Makroyla falan uğraşılmasına gerek kalmaz....

.

 

[Tevfik_Kursun]

Merhaba Sayın Haluk Hocam,
Verdiğiniz script ile yaptım. Ama 6000 civarında resim var en çok 1800 civarında duruyor. Yeniden başladığınızda da baştan başlıyor. Bu nedenle linkleri sağlıklı olarak aldığımdan tam emin değilim. Buradaki makroları görünce bir de böyle deneyeyim dedim.
Eğer elimdeki script için çözüm varsa şahane olur, çok ta makbule geçer.
Saygılarımla

 

[yasin85]

Sub selenium_urlAl()
'Selenium Web Driver kurulu olmalı
'Referanslardan Selenium Type Library seçili olmalı.

    Set driver = New ChromeDriver
    Set By = New By

    With driver

        For i = 2 To Cells(Rows.Count, 1).End(3).Row
            .Get Cells(i, 1).Value

            While .ExecuteScript("return document.readyState") <> "complete"
                .Wait (5000)
            Wend

            If .FindElements(By.ID("product-product")).Count > 0 Then
                Set t = .FindElementByCss("#content > div.row > div.col-sm-8 > ul.thumbnails")
                Set a = t.FindElementsByCss(".thumbnail")
                For ii = 1 To a.Count
                    Cells(i, ii + 1).Value = a(ii).Attribute("href")
                Next ii
            Else
                Cells(i, 2).Value = "Ürün Bulunamadı."
            End If

        Next i

    End With

End Sub

Sn. @veyselemre Bey,

Zaman ayırıpcevap verdiğiniz için teşekkür ederim.
'Referanslardan Selenium Type Library seçili olmalı. demişsiniz kullandığımız excelde referans kısmında selenium cıkmadı onu nasıl ekleriz deneye bilmek için.

 

[yasin85]

Alternatif;

Sub Test()
'   Haluk - 08/08/2021
'   sa4truss@gmail.com
'   https://excelhaluk.blogspot.com/

    Dim HTTP As Object, HTML As Object, NoA As Integer, iRow As Integer, i As Integer, j As Integer
    Dim myURL As String
   
    Range("B2:G" & Rows.Count) = ""
   
    Set HTML = CreateObject("HTMLFILE")
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
   
    NoA = Range("A" & Rows.Count).End(xlUp).Row
   
    For iRow = 2 To NoA
        myURL = Range("A" & iRow).Text
       
        HTTP.Open "GET", myURL, False
        HTTP.send
       
        HTML.body.innerHTML = HTTP.responseText
        Set objCollection = HTML.getElementsByTagName("li")
       
        i = 0
        j = 1
        Do While i < objCollection.Length
            If objCollection(i).classname = "image-additional" Then
                Set objImgs = objCollection(i).getElementsByTagName("a")
                j = j + 1
                Cells(iRow, j) = objImgs(0).href
            End If
            i = i + 1
        Loop
    Next
   
    Set objImgs = Nothing
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

Sn. @Haluk Bey ,
Çalışmanız tam istediğimiz gibi çalışıyor emeğine sağlık.
Teşekkürler.