- 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.
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