Inserting picture from a dynamic URL in a cell
Likes Likes:  0
Page 1 of 4 123 ... LastLast
Results 1 to 10 of 35

Thread: Inserting picture from a dynamic URL in a cell

  1. #1
    New Member
    Join Date
    Dec 2017
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Inserting picture from a dynamic URL in a cell

     
    I've been trying out and testing different codes online but I can't get mine to consistently work.

    The situation is this:

    I want to be able to paste in a URL in Cell A1 so that in Cell B2, it will show the downloaded image from the link. The worksheet will be called "URL Report"

    I'm having trouble understanding the exact objects and codes that can make this happen - I'm still pretty new to VBA

    I've been using this code:
    Code:
    Sub URLPictureInsert()
    Dim Pshp As Shape
    On Error Resume Next
    Application.ScreenUpdating = False
    Set Rng = Worksheets("URL Report").Range("A1")
    For Each cell In Rng
    filenam = cell
    Worksheets("URL Report").Pictures.Insert(filenam).Select
    Set Pshp = Selection.ShapeRange.Item(1)
    With Pshp
    .LockAspectRatio = msoTrue
    .Width = 100
    .Height = 100
    .Cut
    End With
    Cells(cell.Row, cell.Column + 1).PasteSpecial
    Next
    Application.ScreenUpdating = True
    End Sub




    I F8'd line by line but I still can't get the image to extract into the cell - any advice?

  2. #2
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    17,895
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Inserting picture from a dynamic URL in a cell

    Try the following...

    Code:
    Sub URLPictureInsert()
        Dim ws As Worksheet
        Dim rRange As Range
        Dim rCell As Range
        Dim sFileName As String
        Dim LastRow As Long
        Application.ScreenUpdating = False
        Set ws = Worksheets("URL Report")
        With ws
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rRange = .Range("A1:A" & LastRow)
        End With
        For Each rCell In rRange
            sFileName = rCell.Value
            ws.Shapes.AddPicture _
                Filename:=sFileName, _
                LinkToFile:=msoFalse, _
                SaveWithDocument:=msoTrue, _
                Left:=rCell.Offset(, 1).Left, _
                Top:=rCell.Top, _
                Width:=100, _
                Height:=100
        Next rCell
        Application.ScreenUpdating = True
    End Sub
    You'll notice that Shapes.AddPicture is used instead of Pictures.Insert.

    Hope this helps!
    Last edited by Domenic; Dec 5th, 2017 at 06:37 PM.

  3. #3
    New Member
    Join Date
    Dec 2017
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Inserting picture from a dynamic URL in a cell

    Quote Originally Posted by Domenic View Post
    Try the following...

    Code:
    Sub URLPictureInsert()
        Dim ws As Worksheet
        Dim rRange As Range
        Dim rCell As Range
        Dim sFileName As String
        Dim LastRow As Long
        Application.ScreenUpdating = False
        Set ws = Worksheets("URL Report")
        With ws
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rRange = .Range("A1:A" & LastRow)
        End With
        For Each rCell In rRange
            sFileName = rCell.Value
            ws.Shapes.AddPicture _
                Filename:=sFileName, _
                LinkToFile:=msoFalse, _
                SaveWithDocument:=msoTrue, _
                Left:=rCell.Offset(, 1).Left, _
                Top:=rCell.Top, _
                Width:=100, _
                Height:=100
        Next rCell
        Application.ScreenUpdating = True
    End Sub
    You'll notice that Shapes.AddPicture is used instead of Pictures.Insert.

    Hope this helps!
    Thanks Domenic

    When I press F5 to go through the code, it gives me the error:

    "The specified file wasn't found, and it highlights this portion:
    Code:
    ws.Shapes.AddPicture _
    Filename:=sFileName, _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, _
    Left:=rCell.Offset(, 1).Left, _
    Top:=rCell.Top, _
    Width:=100, _
    Height:=100
    Last edited by sinasdf; Dec 6th, 2017 at 02:59 PM.

  4. #4
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    17,895
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Inserting picture from a dynamic URL in a cell

    You can check whether the URL exists before trying to download the picture. First, place the following function in a regular module...

    Code:
    Function URLExists(sURL As String) As Boolean
    
        Dim XMLReq As Object
        
        If Not LCase(sURL) Like "http://*" Then
            sURL = "http://" & sURL
        End If
        
        On Error GoTo ErrHandler
        
        Set XMLReq = CreateObject("MSXML2.XMLHTTP")
        With XMLReq
            .Open "GET", sURL, False
            .send
            URLExists = (.Status = 200)
        End With
        
    ErrHandler:
        Set XMLReq = Nothing
        
    End Function
    Then, make the following changes in red...

    Code:
    Sub URLPictureInsert()
        Dim ws As Worksheet
        Dim rRange As Range
        Dim rCell As Range
        Dim sFileName As String
        Dim LastRow As Long
        Application.ScreenUpdating = False
        Set ws = Worksheets("URL Report")
        With ws
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rRange = .Range("A1:A" & LastRow)
        End With
        For Each rCell In rRange
            sFileName = rCell.Value
            If URLExists(sFileName) Then
                ws.Shapes.AddPicture _
                    Filename:=sFileName, _
                    LinkToFile:=msoFalse, _
                    SaveWithDocument:=msoTrue, _
                    Left:=rCell.Offset(, 1).Left, _
                    Top:=rCell.Top, _
                    Width:=100, _
                    Height:=100
            Else
                rCell.Offset(, 1).Value = "File not found" 'optional
            End If
        Next rCell
        Application.ScreenUpdating = True
    End Sub
    Hope this helps!

  5. #5
    New Member
    Join Date
    Dec 2017
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Inserting picture from a dynamic URL in a cell

    Hi Domenic,

    Thank you again for your help - I appreciate it

    I played around with the links and I finally got it to work - I noticed however that some links work and some don't.

    For example, I have used the two images:
    http://glintdemoz.com/timelylife/assets/attached_files/923_2016_06_11_12_23_27_test.jpg
    https://images-na.ssl-images-amazon.com/images/I/41xfT8vfYnL.jpg

    The first one works fine, but the second one doesn't.

    I then played around with the code to use https instead of http, which results in the first one showing File not found, while the second one results in a run-time error with "the specified file wasn't found"

    Do you have any ideas why the second image URL is giving me issues?
    Last edited by sinasdf; Dec 7th, 2017 at 10:53 AM.

  6. #6
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    17,895
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Inserting picture from a dynamic URL in a cell

    That's because the function URLExists checks whether the URL starts with "http://". If not, it adds it at the beginning. And so with a URL starting with "https://", the test fails. As a result, it adds "http://" at the beginning, which makes the URL incorrect. Since it looks like "http" doesn't need to be part of the URL, you can simply remove this part of the code...

    Code:
        If Not LCase(sURL) Like "http://*" Then
            sURL = "http://" & sURL
        End If

  7. #7
    New Member
    Join Date
    Dec 2017
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Inserting picture from a dynamic URL in a cell

    Quote Originally Posted by Domenic View Post
    That's because the function URLExists checks whether the URL starts with "http://". If not, it adds it at the beginning. And so with a URL starting with "https://", the test fails. As a result, it adds "http://" at the beginning, which makes the URL incorrect. Since it looks like "http" doesn't need to be part of the URL, you can simply remove this part of the code...

    Code:
        If Not LCase(sURL) Like "http://*" Then
            sURL = "http://" & sURL
        End If
    I did remove this and its still giving me the "file wasn't found" error

    It happens at this point of the code for the https link:

    ws.Shapes.AddPicture _
    Filename:=sFileName, _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, _
    Left:=rCell.Offset(, 1).Left, _
    Top:=rCell.Top, _
    Width:=100, _
    Height:=100

    I just tried it with another link with https that is not amazon related and it works fine.

    But only the amazon link has the issue. For the life of me I can't figure why!

  8. #8
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    17,895
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Inserting picture from a dynamic URL in a cell

    First, let me correct myself. The "http" part is indeed needed. Even so, when I try running the code with the problem URL included, the function URLExists returns True, but I get the same runtime error when it tries to add/download the picture. From what I can tell, there doesn't seem to be any characters that need to be encoded, so I don't know why an error occurs.
    Last edited by Domenic; Dec 7th, 2017 at 06:54 PM.

  9. #9
    New Member
    Join Date
    Dec 2017
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Inserting picture from a dynamic URL in a cell

    Quote Originally Posted by Domenic View Post
    First, let me correct myself. The "http" part is indeed needed. Even so, when I try running the code with the problem URL included, the function URLExists returns True, but I get the same runtime error when it tries to add/download the picture. From what I can tell, there doesn't seem to be any characters that need to be encoded, so I don't know why an error occurs.
    Thank you very much for your help - at least I know now the right code to accomplish this task.

    The purpose of this task was to be able to insert the ASIN into a cell (Amazon's product identifier) which would populate all sorts of financial and sales metric data, as well as the image url based on a list I created.

    But it's not working so it's all for naught :/

  10. #10
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    17,895
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Inserting picture from a dynamic URL in a cell

      
    An alternative would be to first download the the file to a temporary folder using the XMLHTTP object, and then insert the file from there into Excel using the AddPicture method. So, as before, we would have the function URLExists to make sure the URL exists, and then we would have another function, SaveWebFile, to download the file into a temporary folder. Then, once it's inserted into the worksheet using the AddPicture method, the temporary file is deleted.

    Code:
    Function URLExists(sURL As String) As Boolean
    
        Dim XMLReq As Object
        
        On Error GoTo ErrHandler
        
        Set XMLReq = CreateObject("MSXML2.XMLHTTP")
        With XMLReq
            .Open "GET", sURL, False
            .Send
            URLExists = (.Status = 200)
        End With
        
    ErrHandler:
        Set XMLReq = Nothing
        
    End Function
    Code:
    'http://www.vbaexpress.com/kb/getarticle.php?kb_id=799
    
    Function SaveWebFile(ByVal vWebFile As String, ByVal vLocalFile As String) As Boolean
        Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte
         
         'You can also set a ref. to Microsoft XML, and Dim oXMLHTTP as MSXML2.XMLHTTP
        Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
        oXMLHTTP.Open "GET", vWebFile, False 'Open socket to get the website
        oXMLHTTP.Send 'send request
         
         'Wait for request to finish
        Do While oXMLHTTP.readyState <> 4
            DoEvents
        Loop
         
        oResp = oXMLHTTP.responseBody 'Returns the results as a byte array
         
         'Create local file and save results to it
        vFF = FreeFile
        If Dir(vLocalFile) <> "" Then Kill vLocalFile
        Open vLocalFile For Binary As #vFF 
        Put #vFF , , oResp
        Close #vFF 
         
         'Clear memory
        Set oXMLHTTP = Nothing
    End Function
    Code:
    Sub URLPictureInsert()
        Dim ws As Worksheet
        Dim rRange As Range
        Dim rCell As Range
        Dim sURL As String
        Dim sTempFile As String
        Dim LastRow As Long
        Application.ScreenUpdating = False
        Set ws = Worksheets("URL Report")
        With ws
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rRange = .Range("A1:A" & LastRow)
        End With
        For Each rCell In rRange
            If Len(rCell) > 0 Then
                sURL = rCell.Value
                If URLExists(sURL) Then
                    sTempFile = Environ("temp") & "\" & Mid(sURL, InStrRev(sURL, "/") + 1)
                    SaveWebFile sURL, sTempFile
                    ws.Shapes.AddPicture _
                        Filename:=sTempFile, _
                        LinkToFile:=msoFalse, _
                        SaveWithDocument:=msoTrue, _
                        Left:=rCell.Offset(, 1).Left, _
                        Top:=rCell.Top, _
                        Width:=100, _
                        Height:=100
                        Kill sTempFile
                Else
                    rCell.Offset(, 1).Value = "File not found" 'optional
                End If
            End If
        Next rCell
        Application.ScreenUpdating = True
    End Sub
    Last edited by Domenic; Dec 9th, 2017 at 12:16 PM.

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com