1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Unable to place the downloaded images right next to each url in a spreadsheet

Discussion in 'VBA Macros' started by shahin, Aug 23, 2018.

  1. shahin

    shahin Active Member

    Messages:
    899
    I've written a script in vba to download few images using some urls already available in coulmn B in a spreadsheet and place the downloaded images right next to concerning urls in column C. If it were not for amazon I could have done the same using the following piece of code:

    Code (vb):

    Sub InsertImages()
        Dim pics$, myPics As Shape, PicExists As Boolean, cel As Range

        For Each cel In Range("C2", Range("B2").End(xlDown).Offset(0, 1))
            PicExists = False
            pics = cel.Offset(0, -1)

            For Each myPics In ActiveSheet.Shapes
                If myPics.TopLeftCell.Row = cel.Row Then PicExists = True: Exit For
            Next myPics

            If Not PicExists Then
                With ActiveSheet.Pictures.Insert(pics)
                   .ShapeRange.LockAspectRatio = msoTrue
                   .Top = Rows(cel.Row).Top
                   .Left = Columns(cel.Column).Left
                End With
            End If
        Next cel
    End Sub
     
    But the thing is I can't do that because amazon does not let me accomplish the task the way I tried above.

    However, I tried another way (fully hypothetical) to do the trick. Firstly I downloaded the images using ADODB and then comply with the above method to place the images right next to concerning cells using the following approach but failed miserably. How can i make it a go successfully?

    Code (vb):

    Sub DownloadFileFirst()
        Dim Http As New XMLHTTP60, cel As Range
        Dim temparr As Variant, StrFile$

        For Each cel In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
            temparr = Split(cel, "/")
            temparr = temparr(UBound(temparr))

            Http.Open "GET", cel, False
            Http.send

            With CreateObject("ADODB.Stream")
                 .Open
                 .Type = 1
                 .write Http.responseBody
                 .SaveToFile "C:\Users\WCS\Desktop\UpDown\" & temparr, 2
                 .Close
             End With
        Next cel
       
        For Each cel In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
            StrFile = Dir("C:\Users\WCS\Desktop\UpDown\")
            Do While Len(StrFile) > 0
                If InStr(cel, StrFile) > 0 Then
                    With cel(1, 2).Pictures.Insert(StrFile)
                       .ShapeRange.LockAspectRatio = msoTrue
                       .Top = Rows(.Row).Top
                       .Left = Columns(.Column).Left
                    End With
                    StrFile = Dir
                End If
            Loop
        Next cel
    End Sub
     
    Images urls are in column B and I wish to place the downloaded images right next to each url in column C.

    Few urls are like:

    Code (vb):

    https://images-na.ssl-images-amazon.com/images/I/51c4wH-24hL._SL100_SS100_.jpg
    https://images-na.ssl-images-amazon.com/images/I/414OmQfjqBL._SL100_SS100_.jpg
    https://images-na.ssl-images-amazon.com/images/I/21SvLWEwzuL._SL100_SS100_.jpg
    https://images-na.ssl-images-amazon.com/images/I/51G7w%2BTdPAL._SL100_SS100_.jpg
    https://images-na.ssl-images-amazon.com/images/I/516QJcni8fL._SL100_SS100_.jpg
     
  2. Kenneth Hobson

    Kenneth Hobson Active Member

    Messages:
    225
    Untested, maybe use cell(1,2)?

    Code (vb):
    .Top = cel(1,2).Top
    .Left = cel(1,2).Left
    I would probably use the API method to download a file though I prefer the first method when possible.
    shahin likes this.
  3. Chihiro

    Chihiro Excel Ninja

    Messages:
    5,053
    Why are you using DIR() to retrieve file and looping each file to find match? When you already have the file name & folder path already within the code.

    I'd also use .Shapes.Addpicture() method.

    Code (vb):
    Sub DownloadFileFirst()
        Dim Http As New XMLHTTP60, cel As Range
        Dim temparr As Variant, StrFile$
        Dim fpath$, p As Shape
        fpath = "C:\Test\UpDown\"
        For Each cel In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
            temparr = Split(cel, "/")
            temparr = temparr(UBound(temparr))

            Http.Open "GET", cel, False
            Http.send

            With CreateObject("ADODB.Stream")
                .Open
                .Type = 1
                .write Http.responseBody
                .SaveToFile fpath & temparr, 2
                .Close
            End With
        Next cel
       
        For Each cel In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
            temparr = Split(cel, "/")
            temparr = temparr(UBound(temparr))
            With ActiveSheet
                Set p = .Shapes.AddPicture(fpath & temparr, False, True, cel.Offset(, 1).Left, cel.Top, -1, -1)
                cel.RowHeight = p.Height
            End With
        Next
    End Sub
    Thomas Kuriakose and shahin like this.
  4. shahin

    shahin Active Member

    Messages:
    899
    @Sir Chiro, Its a long time since i hear anything from you. I realy can't understand as to how i can make it a go successfully.It would be a great pleasure if i could get any specific instruction from you to make the code executable.
  5. Chihiro

    Chihiro Excel Ninja

    Messages:
    5,053
    Did my code not work?

    At any rate, major issue is here.
    Code (vb):
    With cel(1, 2).Pictures.Insert(StrFile)
    StrFile will return only the file name, so you'd need to concatenate it with folder path.

    But, my question is... Why loop through all the file names?
    When you can extract file name from cel.Value and concatenate it with static folder path.
    shahin likes this.
  6. shahin

    shahin Active Member

    Messages:
    899
    @Sir Chihiro, your code never fails to meet the criteria. I was not around so I had no option to test that. I'll surely let you know. Thanks.
  7. shahin

    shahin Active Member

    Messages:
    899
    Yessssssssssss!!!!!!!! It did the job just perfect @ sir chihiro!!!!!
  8. shahin

    shahin Active Member

    Messages:
    899
    One last thing to know on this sir: is it possible to do the same without creating any folder, I meant saving the images in the clipboard and reuse it?
  9. Chihiro

    Chihiro Excel Ninja

    Messages:
    5,053
    Probably. If you have code for copying, then code to paste would be something like...
    Code (vb):
    ActiveSheet.PasteSpecial Format:="Bitmap", link:=False, DisplayAsIcon:=False
    Then you can manipulate it like any other shape.
    shahin likes this.

Share This Page