Home » excel » vba – Excel convert URL to images (1004)

vba – Excel convert URL to images (1004)

Posted by: admin April 23, 2020 Leave a comment

Questions:

I have an excel document linked to an SQL database which contains several columns of image URLs.

One of those URLs looks like this:
https://imissit.blob.core.windows.net/iris/596480cf967e0c990c37fba3725ada0c/814040e2-0ccb-4b05-bdb3-d9dc9cc798d9/texture.png
https://imissit.blob.core.windows.net/iris/596480cf967e0c990c37fba3725ada0c/814040e2-0ccb-4b05-bdb3-d9dc9cc798d9/texture.png

I found different approaches and methods on how to convert those URLs to images ( e.g.
Excel VBA Insert Images From Image Name in Column and https://superuser.com/questions/940861/how-can-i-display-a-url-as-an-image-in-an-excel-cell) within the excel document using macros. I tried those approaches but none of them works for my kind of URL. I tried other URLs (random images on the web, http and https and for those images it WORKS).

This is one of the snippets I tried, which works for other images:

   Sub InstallPictures()
    Dim i As Long, v As String
    For i = 2 To 2
        v = Cells(i, "O").Value
        If v = "" Then Exit Sub
        With ActiveSheet.Pictures
            .Insert (v)
        End With
    Next i
End Sub

Anyway when trying it with my URL I get a runtime error 1004: Insert method of picture object cannot be executed(translated). Different approaches result in slightly different runtime errors (although 1004 is consistent).

Here are some image URLs I tried that work:

https://docs.oracle.com/cd/E21454_01/html/821-2584/figures/HTTPS_Collab_Sample.png

http://www.w3schools.com/css/paris.jpg

https://scontent.ftxl1-1.fna.fbcdn.net/v/t1.0-9/13043727_278733959131361_2241170037980408109_n.jpg?oh=bec505696c5f66cde0cc3b574a70547c&oe=58CC35C5

What is different from my URL to the others and why those methods don’t work? What is the correct approach?

How to&Answers:

The problem (as far as I can tell) is not your device, but it’s on the server that is hosting the image, and is failing to return the document. I’m not sure where Tim’s comment above (pertaining to the 206 response code) comes from, but if that’s the case, or if the URL is returning some error code, then your VBA would also fail and there is likely nothing you can do to resolve that if the problem is at the host.

I manually enter the URL today and download the file, no problem.

I check the response code and it’s returning correctly a 200 (success).

enter image description here

The best you can do at this point is to simply trap the error, and flag it for later review.

In my test, I used some deliberatly bad URL just to ensure error handling is working as expected. These are the only ones that failed for me.

enter image description here

Here’s the code I used, modified only slightly from yours and includes an error-handler to add a COMMENT to the cells which URLs return the error. This way you can later review manually and add those images if needed.

Sub InstallPictures()
    Dim i As Long
    Dim v As String
    Dim cl As Range
    Dim pic As Shape
    Dim errors As New Collection

    i = 2
    Set cl = Cells(i, 15)
    Do While Trim(cl.Value) <> vbNullString
        v = Trim(cl.Value)
        cl.ClearComments

        With ActiveSheet.Pictures
            On Error GoTo ErrHandler
            Set p = .Insert(Trim(v))
            On Error GoTo 0
            ' I added this code to resize & arrange the pictures
            ' you can remove it if you don't need it
            p.TopLeftCell = cl.Offset(0, -1)
            p.Top = cl.Offset(0, -1).Top
            p.Left = cl.Offset(0, -1).Left
            p.Height = Cells(i, 15).Height
            p.Width = Cells(1, 15).Width
            '''''''''''''''''''''''''''''
        End With

NextCell:
        i = i + 1
        Set cl = Cells(i, 15)
    Loop

    If errors.Count > 0 Then
        MsgBox "There were errors, please review the comments as some files may need to be manually downloaded"
    End If

    Exit Sub


ErrHandler:
    Call ErrorNote(v, cl, errors)
    Resume NextCell
End Sub

Private Sub ErrorNote(url$, cl As Range, ByRef errs As Collection)
' Adds an item to the errs collection and flags the offending
' cell with a Comment indicating the error occurred. 
    On Error Resume Next
    errs.Add (url)
    With cl
        .ClearComments
        .AddComment ("Error with URL: " & vbCrLf & url)
    End With
End Sub