Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Insert image from URL

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.

like image 321
Exam Orph Avatar asked Sep 17 '25 06:09

Exam Orph


2 Answers

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.

like image 68
Vityata Avatar answered Sep 19 '25 04:09

Vityata


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
like image 37
Tim Williams Avatar answered Sep 19 '25 03:09

Tim Williams