shahin
Active Member
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:
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?
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:
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:
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:
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