当 url 包含特殊字符(如 "ä")时下载图像



我使用以下VBA代码下载图像。url来自我的客户端。
它适用于几乎所有的url,如https://www.fleur ami.com/out/pictures/master/product/1/sofa samt -橄榄约瑟芬- tingo -生活- 24111. - jpg

有些url带有特殊字符,如"ä"和/或"ß"。https://www.fleur-ami.com/out/pictures/master/product/1/bodengef%C3%A4%C3%9F-XXL-anthrazit-tribeca-shape-natural-raw-24541-N.jpg
对于这些url,不会下载图像。你可以试试,不需要密码和用户名。

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:fleuramibilderapi2.0" & artikelnummer & "-1.jpg"
Worksheets("datenabruf").Cells(i, 100) = artikelnummer & "-1.jpg"
ElseIf j = 47 Then
zieladresse = "Z:fleuramibilderapi2.0" & artikelnummer & "-2.jpg"
Worksheets("datenabruf").Cells(i, 101) = artikelnummer & "-2.jpg"
ElseIf j = 48 Then
zieladresse = "Z:fleuramibilderapi2.0" & artikelnummer & "-3.jpg"
Worksheets("datenabruf").Cells(i, 102) = artikelnummer & "-3.jpg"
ElseIf j = 49 Then
zieladresse = "Z:fleuramibilderapi2.0" & artikelnummer & "-4.jpg"
Worksheets("datenabruf").Cells(i, 103) = artikelnummer & "-4.jpg"
ElseIf j = 50 Then
zieladresse = "Z:fleuramibilderapi2.0" & artikelnummer & "-5.jpg"
Worksheets("datenabruf").Cells(i, 104) = artikelnummer & "-5.jpg"
ElseIf j = 51 Then
zieladresse = "Z:fleuramibilderapi2.0" & artikelnummer & "-6.jpg"
Worksheets("datenabruf").Cells(i, 105) = artikelnummer & "-6.jpg"
ElseIf j = 52 Then
zieladresse = "Z:fleuramibilderapi2.0" & artikelnummer & "-7.jpg"
Worksheets("datenabruf").Cells(i, 106) = artikelnummer & "-7.jpg"
ElseIf j = 53 Then
zieladresse = "Z:fleuramibilderapi2.0" & artikelnummer & "-8.jpg"
Worksheets("datenabruf").Cells(i, 107) = artikelnummer & "-8.jpg"
ElseIf j = 54 Then
zieladresse = "Z:fleuramibilderapi2.0" & artikelnummer & "-9.jpg"
Worksheets("datenabruf").Cells(i, 108) = artikelnummer & "-9.jpg"
ElseIf j = 55 Then
zieladresse = "Z:fleuramibilderapi2.0" & artikelnummer & "-10.jpg"
Worksheets("datenabruf").Cells(i, 109) = artikelnummer & "-10.jpg"
ElseIf j = 56 Then
zieladresse = "Z:fleuramibilderapi2.0" & artikelnummer & "-11.jpg"
Worksheets("datenabruf").Cells(i, 110) = artikelnummer & "-11.jpg"
ElseIf j = 57 Then
zieladresse = "Z:fleuramibilderapi2.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

如果你所有的URL都有相同的模式,你只需要URLencode的最后一部分:

Sub Tester()
Dim url, arr
url = "https://www.fleur-ami.com/out/pictures/master/product/1/bodengefäß-XXL-anthrazit-tribeca-shape-natural-raw-24541-N.jpg"

arr = Split(url, "/product/1/")

If UBound(arr) = 1 Then
url = arr(0) & "/product/1/" & Application.EncodeURL(arr(1))
'>> https://www.fleur-ami.com/out/pictures/master/product/1/bodengef%C3%A4%C3%9F-XXL-anthrazit-tribeca-shape-natural-raw-24541-N.jpg
Debug.Print url
End If

End Sub

最新更新