LİNKLERDEKİ FOTOĞRAFLARI TOPLU BİR ŞEKİLDE İNDİRME

[seyfullah12]

Arkadaşlar merhabalar, bir excel dosyasında bulunan linklerden yaklaşık olarak 10.000 adet fotoğrafı tek tek indirip dosyalamam gerekiyor, bu konuda herhangi bir kısayolla istediğim dosyalamayı yapabilir miyim, bir kaç yere baktım da konuyu doğru yere açıp açmadığım konusunda emin bile değilim, exceli acemi şekilde yeni yeni kullananlardanım, kod yazıp bu şekilde bir indirme gerçekleştirebilir miyiz acaba? Resimde örnek olarak göstercem yardımcı olabilirseniz çok çok sevinirim, teşekkür ederim. İyi çalışmalar.

https://hizliresim.com/o2twe5j
Buraya resim yükleyemediğim için link olarak atıyorum.
Misal sol kısımda bulunan sayılar dosya adı olacak, o satırda bulunan linkten de fotoğraflar bu dosyanın içerisine indirilecek. Umarım anlatabilmişimdir. Tekrardan teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Arşiv konularını inceleyiniz.

Arşiv Konuları

 

[RBozkurt]

Örnekteki şekilde yaparsanız çalışır. Resim adreslerinde uzantı olmak zorundadır.

Sub ResimleriKaydet()
    Dim ws As Worksheet
    Dim i As Long
    Dim DosyaAdi As String
    Dim URL As String
    Dim Uzanti As String
    Dim Resim As Object
    Dim xmlHTTP As Object
    Dim respXML As Object
    Dim fs As Object

    Set ws = ThisWorkbook.Sheets("Sayfa1")
    Set xmlHTTP = CreateObject("MSXML2.XMLHTTP")
    Set fs = CreateObject("Scripting.FileSystemObject")

    For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        DosyaAdi = ws.Cells(i, "A").Value
        URL = ws.Cells(i, "B").Value
        
        If DosyaAdi <> "" And URL <> "" Then
            Uzanti = Right(URL, Len(URL) - InStrRev(URL, "."))
            DosyaAdi = DosyaAdi & "." & Uzanti
            
            xmlHTTP.Open "GET", URL, False
            xmlHTTP.send

            If xmlHTTP.Status = 200 Then
                Set Resim = CreateObject("ADODB.Stream")
                Resim.Open
                Resim.Type = 1
                Resim.Write xmlHTTP.responseBody
                Resim.SaveToFile ThisWorkbook.Path & "\" & DosyaAdi, 2
                Resim.Close
            Else
                MsgBox "Resim indirilemedi: " & URL
            End If
        End If
    Next i

    Set xmlHTTP = Nothing
    Set fs = Nothing
    Set Resim = Nothing

    MsgBox "Resimler başarıyla kaydedildi."
End Sub

 

[seyfullah12]

maalesef çalıştıramadım

 

[RBozkurt]

maalesef çalıştıramadım

A sütünuna dosya adı, B sütununa örnekteki gibi uzantısı açık şekilde resim url adresi eklenecek.
Eger resim linki sizin 1. Mesaja eklediğiniz gibi yönlendirme ise çalışmaz.