Insert Image from Website - unable to get insert property of image

JohnDoe1976

New Member
Joined
Nov 17, 2020
Messages
2
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
  5. 2011
  6. 2010
  7. 2007
Platform
  1. Windows
Hi all, I've trailed a LOT of posts trying to find the answer, and I've seen similar issues but not this one.

Essentially I'm trying to insert this image (+others) into my workbook:

but I'm getting this:
1648122774936.png


code is below:

Sub URLPictureInsert()
Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
'On Error Resume Next (commented out for now)
Application.ScreenUpdating = False
LR = Sheets("Range Vis").Range("E65536").End(xlUp).Row
Set Rng = Sheets("Range Vis").Range("E3:E" & LR)
For Each cell In Rng
filenam = cell
ActiveSheet.Pictures.Insert(filenam).Select
Set Pshp = Selection.ShapeRange.Item(1)
If Pshp Is Nothing Then GoTo lab
xCol = cell.Column + 13
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
If .Width > xRg.Width Then .Width = xRg.Width * 2 / 3
If .Height > xRg.Height Then .Height = xRg.Height * 2 / 3
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
lab:
Set Pshp = Nothing
Range("A2").Select
Next
Application.ScreenUpdating = True
End Sub

Can anyone help please?
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
When I try using Pictures.Insert for inserting your image, I too get the same error.

And when I try using Shapes.AddPicture instead, it too generates a run-time error, saying that the specified file wasn't found.

Here's an alternative that seems to work. You'll need to amend it in order to suit your needs. It first downloads the image onto your local hard drive using the XMLHTTP object. Then it inserts the image onto the active worksheet. And then it deletes the downloaded file.

VBA Code:
Option Explicit

Sub test()

    Dim webFilename As String
    webFilename = "https://digitalcontent.api.tesco.com/v2/media/ghs/cb5c0271-087a-4f78-94d0-abe242d51d69/4840f76e-217e-4c1e-bd1b-4ad962e52863.jpg"
    
    Dim localFilename As String
    localFilename = Environ("temp") & "\temp.gif"
    
    Dim errorMessage As String
    If Not DownloadFile(webFilename, localFilename, errorMessage) Then
        MsgBox errorMessage, vbCritical, "Error"
        Exit Sub
    End If
    
    Dim pic As Picture
    Set pic = ActiveSheet.Pictures.Insert(localFilename)
    
    With pic
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = Range("A2").Left
        .Top = Range("A2").Top
    End With

    Kill localFilename
    
End Sub

Public Function DownloadFile(ByVal webFilename As String, ByVal localFilename As String, ByRef errorMessage As String) As Boolean

    Dim xmlReq As Object
    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
    
    With xmlReq
        .Open "GET", webFilename, False
        .send
        Do While .readystate <> 4
            DoEvents
        Loop
        If .Status <> 200 Then
            errorMessage = "Error " & .Status & ": " & .StatusText
            Set xmlReq = Nothing
            DownloadFile = False
            Exit Function
        End If
        Dim resp() As Byte
        resp() = .responsebody
    End With
    
    Dim fileNumber As Long
    fileNumber = FreeFile()
    
    Open localFilename For Binary As #fileNumber
        Put #fileNumber, , resp
    Close #fileNumber
    
    Set xmlReq = Nothing
    
    DownloadFile = True
    
End Function

Hope this helps!
 
Upvote 0
Another api based alternative that I use :

VBA Code:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As LongPtr, lpCLSID As Any) As Long
    Private Declare PtrSafe Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As LongPtr, ByVal punkCaller As LongPtr, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
#Else
    Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
    Private Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
#End If

Public Function apiInsertPicture(ByVal InsertSheet As Worksheet, ByVal Filename As String) As Picture

    Dim bIPic(15) As Byte
    Dim IPic As Picture
    Dim sExtension As String, sTempFile As String

    If InStrRev(Filename, ".") Then
        sExtension = Right(Filename, Len(Filename) - InStrRev(Filename, "."))
        Call CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), bIPic(0))
        If OleLoadPicturePath(StrPtr(Filename), 0&, 0&, 0&, bIPic(0), IPic) = 0 Then
            sTempFile = Environ("temp") & "\" & Second(Now) & "." & sExtension
            stdole.SavePicture IPic, sTempFile
            Set apiInsertPicture = InsertSheet.Pictures.Insert(sTempFile)
            Kill sTempFile
        End If
    End If

End Function


Usage example:
VBA Code:
Sub Test()

    Dim oPic As Picture
    
    Set oPic = apiInsertPicture(ActiveSheet, "https://digitalcontent.api.tesco.com/v2/media/ghs/cb5c0271-087a-4f78-94d0-abe242d51d69/4840f76e-217e-4c1e-bd1b-4ad962e52863.jpg")

    If Not oPic Is Nothing Then
        With oPic
            .ShapeRange.LockAspectRatio = msoFalse
            .Left = Range("A2").Left
            .Top = Range("A2").Top
            .Width = 150
            .Height = 150
        End With
    Else
        MsgBox "Failed to insert picture.", vbExclamation
    End If

End Sub
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top