The following code works fine with most image URL's, but for this specific URL I am getting errors:
Sub test()
Sheets(1).Shapes.AddPicture "https://images-na.ssl-images-amazon.com/images/M/MV5BYzVlY2JiODctNGMzNC00OWE5LTg3MTEtNDQ3NDYxNjIxNTBiXkEyXkFqcGdeQXVyNTM3MDMyMDQ@._V1_.jpg" _
, msoFalse, msoTrue, 100, 100, 500, 600
End Sub
Run-time error '1004': The specified file wasn't found
Is it caused by the way this specific URL string is specified (not compatible with VBA)? Or do you think it has something to do with the host blocking access? Thanks.
Try to look for a *.png
pictures. Then it would work.
I have tried with one from the same Amazon website in PNG -
Sub Test()
Sheets(1).Shapes.AddPicture _
"https://images-na.ssl-images-amazon.com/images/I/31TN1u5GEqL.png", _
msoFalse, msoTrue, 100, 100, 500, 600
End Sub
In MSDN they give example with *.bmp
file.
Edit:
However, *.jpg
works from plenty of other websites. Thus probably Amazon is restricting it.
Adding another "fix" since the accepted answer doesn't fully address the issue.
The problem seems to be the specific mechanism used by Excel to request images: you can work around that by separately downloading to a temp file, and inserting the image from there.
Sub URLPictureInsert()
Dim theShape As Shape, rng As Range, cell As Range, Filename As String
Dim tempPath As String
'On Error Resume Next
'Application.ScreenUpdating = False
Set rng = ActiveSheet.Range("A2:A10")
For Each cell In rng
Filename = cell.Value
If Len(Filename) < 5 Then GoTo skip
'download the file to the temp folder and return the path
tempPath = DownLoadedImagePath(Filename)
Set theShape = ActiveSheet.Shapes.AddPicture( _
Filename:=tempPath, linktofile:=msoFalse, _
savewithdocument:=msoCTrue, _
Left:=cell.Left, Top:=cell.Top, Width:=60, Height:=60)
With theShape
.LockAspectRatio = msoTrue
.Top = cell.Top + 1
.Left = cell.Left + 1
.Height = cell.Height - 2
'.Width = cell.Width - 2
.Placement = xlMoveAndSize
End With
' Get rid of the
'cell.ClearContents
'isnill:
'Set theShape = Nothing
'Range("A2").Select
skip:
Next
Application.ScreenUpdating = True
Debug.Print "Done " & Now
End Sub
'download content from `url` to a temp file and return the temp file path
Function DownLoadedImagePath(url As String) As String
Dim Data() As Byte, tempPath As String, fNum As Long
With CreateObject("WinHTTP.WinHTTPrequest.5.1")
.Open "GET", url, False
.send
Data = .responseBody
End With
fNum = FreeFile
tempPath = getTempPath()
Open tempPath For Binary Access Write As #fNum
Put #fNum, 1, Data
Close #fNum
DownLoadedImagePath = tempPath
End Function
'return a temporary file path
Function getTempPath() As String
With CreateObject("scripting.filesystemobject")
getTempPath = .GetSpecialFolder(2) & "\" & .GetTempName
End With
End Function
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With