Excel VB.Script URL'den Resim Getirme

Dim pic As String
Dim myPicture As Picture
Dim rng As Range
Dim item As Range
Dim aPic() As Byte
Dim objWin As Object
Dim ImageExists As Boolean

Set rng = Range("c4:c100")
For Each item In rng

    pic = item.Offset(0, -1)
    If pic = "" Then Exit Sub
    pic = "https://acbedding.de/image/catalog/products/_" & pic & "_.jpg"
    
    Set objWin = CreateObject("WinHttp.WinHttpRequest.5.1")
    On Error Resume Next
    With objWin
        .Open "GET", pic, False
        .Send
        aPic = .ResponseBody
    End With
    Set objWin = Nothing
    ImageExists = (InStr(StrConv(aPic, vbUnicode), "404 Not Found") = 0) And (Err.Number = 0)
    
    Set myPicture = ActiveSheet.Pictures.Insert(pic)
    
    With myPicture
    .ShapeRange.LockAspectRatio = msoFalse
    .Width = item.Width
    .Height = item.Height
    .Top = Rows(item.Row).Top
    .Left = Columns(item.Column).Left
    .Placement = xlMoveAndSize
    End With
    
Next

Bu makaleyi yararlı buldunuz mu?