Help Creating Simple Macro to Save Images from URL

[flymeoutofhere]

Hi there.

I have a list of products in a list in Excel with one column containing a direct link to an image file I need to save on my pc.

I am trying to write a macro that will follow the link, and save the image to my pc named as the name of that product from the spreadsheet.

A simplified example:
PRODUCT//IMAGE
Car//http://voiture.de.reve.free.fr/BMW/BMW%20M3%20-%202002%20-%2003.jpg

etc

Thanks!

 

[flymeoutofhere]

Using the Pictures.Insert method was a quick and dirty way. I've tried to read up on this method but there is bitterly little info on it over at MSDN. So as far as resizing goes the only way I can think is to magnify the image by increasing the size in the .ChartObjects.Add method arguments.

Unless we look at a completely different method. I can think of an alternative but it will involve a lot more coding and some Win API. I'm happy to give it a go, just not this minute.

Thanks - I did try the ChartObjects.Add arguments before I replied before and it was stretching the size of the canvas but not the image itself which is weird. Why are the images shrinking?

 

[flymeoutofhere]

Thanks. In Jon's A1:A10 is the filenames to save the jpgs as and B1:B10 is the image source so it isnt working as is and I cant see how to change it around...

 

[Firefly2012]

Change the DownloadFiles sub to this:

Sub DownLoadFiles()
Dim cell As Range, rngListOfURL As Range

Const PTH = "C:\Some Folder\"   'this is your save to location

Set rngListOfURL = Sheet1.Range("B1:B10")   'amend as appropriate

For Each cell In rngListOfURL
    If DownloadURLtoFile(cell.Value, PTH & cell.Offset(, -1).Value & ".jpg") Then
       cell.Offset(, 1).Value = "Successfully downloaded"
    Else
        cell.Offset(, 1).Value = "Error - no download"
    End If
Next cell
  
End Sub

 

[flymeoutofhere]

Amazing thanks! You have saved me many many many hours of uploading images!

 

[Firefly2012]

You're welcome I've not used that API before so it was fun to come up with a working solution.

 

[Jon von der Heyden]

Nice one Firefly2012. I've not seen that API before.

 

[ajpoirier]

Jon, we need someone to write a variation of this macro. Let me if you take new clients. Thanks

 

[Jon von der Heyden]

Hi Alain

Thanks for your email. I've referred you to the MrExcel consulting team. They're a fab bunch and they are most certainly capable of doing what you have asked for.

Cheers
Jon