Eğer Resim Yoksa İndirme

Katılım
19 Temmuz 2016
Mesajlar
129
Excel Vers. ve Dili
2013
Altın Üyelik Bitiş Tarihi
23-08-2020
Merhaba herkese,

Yapmak istediğim linkte görsel yoksa indirmemesi ya da belirli bir kb nin altında olan görselleri indirmemesi.
Aşağıdaki gibi bir kod buldum. Eğer linkte görsel varsa indiriyor. Ben oraya görsel olmayan bir google linki ekledim.

Kod:
Const FolderName As String = "C:\Users\Görsel Test\"

Sub downloadJPGImages()


 
    
 Set ws = ActiveWorkbook.Sheets("Sheet1")
 lLastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

 Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
 Set oBinaryStream = CreateObject("ADODB.Stream")
 adTypeBinary = 1
 oBinaryStream.Type = adTypeBinary

 For i = 2 To lLastRow
    pc9 = ws.Range("A" & i).Value
  sPath = FolderName & ".jpg"
  indir = "https://www.google.com/search?q=kfkfk" & ".jpg"

  On Error GoTo HTTPError
  oXMLHTTP.Open "GET", indir, False
  oXMLHTTP.Send
  aBytes = oXMLHTTP.responsebody
  On Error GoTo 0
 
  oBinaryStream.Open
  oBinaryStream.Write aBytes
  adSaveCreateOverWrite = 2
  oBinaryStream.SaveToFile sPath, adSaveCreateOverWrite
  oBinaryStream.Close

  ws.Range("C" & i).Value = "File successfully downloaded as JPG"

NextRow:
 
 Next

 Exit Sub

HTTPError:

   '''code
 
 Teşekkürler.

 Resume NextRow

End Sub
 
Üst