I am using the following VBA code to download images. The URLs are from my client.
It works for almost all the URLs like
https://www.fleur-ami.com/out/pictures/master/product/1/sofa-samt-olive-josephine-tingo-living-24111.jpg
There are some URLs with special characters like "ä" and/or "ß".
https://www.fleur-ami.com/out/pictures/master/product/1/bodengef%C3%A4%C3%9F-XXL-anthrazit-tribeca-shape-natural-raw-24541-N.jpg
For these URLs the image is not downloaded. You can try it, Password and username is not neccessary.
Sub downloadimage ()
Dim myURL As String
Dim i As Integer
Dim j As Integer
lRow = Worksheets("datenabruf").Cells(Rows.Count, 1).End(xlUp).Row
'Worksheets("datenabruf").Range("cv1:dg" & lRow).ClearContents
For j = 46 To 57
For i = 2 To lRow
artikelnummer = Worksheets("datenabruf").Cells(i, 1)
myURL = Worksheets("datenabruf").Cells(i, j)
If myURL <> "" Then
Dim HttpReq As Object
Set HttpReq = CreateObject("Microsoft.XMLHTTP")
HttpReq.Open "GET", myURL, False, "username", "password"
HttpReq.send
myURL = HttpReq.ResponseBody
If HttpReq.Status = 200 Then
Set oStrm = CreateObject("ADODB.Stream")
oStrm.Open
oStrm.Type = 1
oStrm.Write HttpReq.ResponseBody
If j = 46 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-1.jpg"
Worksheets("datenabruf").Cells(i, 100) = artikelnummer & "-1.jpg"
ElseIf j = 47 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-2.jpg"
Worksheets("datenabruf").Cells(i, 101) = artikelnummer & "-2.jpg"
ElseIf j = 48 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-3.jpg"
Worksheets("datenabruf").Cells(i, 102) = artikelnummer & "-3.jpg"
ElseIf j = 49 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-4.jpg"
Worksheets("datenabruf").Cells(i, 103) = artikelnummer & "-4.jpg"
ElseIf j = 50 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-5.jpg"
Worksheets("datenabruf").Cells(i, 104) = artikelnummer & "-5.jpg"
ElseIf j = 51 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-6.jpg"
Worksheets("datenabruf").Cells(i, 105) = artikelnummer & "-6.jpg"
ElseIf j = 52 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-7.jpg"
Worksheets("datenabruf").Cells(i, 106) = artikelnummer & "-7.jpg"
ElseIf j = 53 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-8.jpg"
Worksheets("datenabruf").Cells(i, 107) = artikelnummer & "-8.jpg"
ElseIf j = 54 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-9.jpg"
Worksheets("datenabruf").Cells(i, 108) = artikelnummer & "-9.jpg"
ElseIf j = 55 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-10.jpg"
Worksheets("datenabruf").Cells(i, 109) = artikelnummer & "-10.jpg"
ElseIf j = 56 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-11.jpg"
Worksheets("datenabruf").Cells(i, 110) = artikelnummer & "-11.jpg"
ElseIf j = 57 Then
zieladresse = "Z:\fleurami\bilder\api2.0\" & artikelnummer & "-12.jpg"
Worksheets("datenabruf").Cells(i, 111) = artikelnummer & "-12.jpg"
End If
oStrm.SaveToFile zieladresse, 2 ' 1 = no overwrite, 2 = overwrite
oStrm.Close
End If
End If
Next i
Next j
Worksheets("datenabruf").Cells(1, 100) = "Bild 1"
Worksheets("datenabruf").Cells(1, 101) = "Bild 2"
Worksheets("datenabruf").Cells(1, 102) = "Bild 3"
Worksheets("datenabruf").Cells(1, 103) = "Bild 4"
Worksheets("datenabruf").Cells(1, 104) = "Bild 5"
Worksheets("datenabruf").Cells(1, 105) = "Bild 6"
Worksheets("datenabruf").Cells(1, 106) = "Bild 7"
Worksheets("datenabruf").Cells(1, 107) = "Bild 8"
Worksheets("datenabruf").Cells(1, 108) = "Bild 9"
Worksheets("datenabruf").Cells(1, 109) = "Bild 10"
Worksheets("datenabruf").Cells(1, 110) = "Bild 11"
Worksheets("datenabruf").Cells(1, 111) = "Bild 12"
End Sub