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]

Can anyone help?

 

[Jon von der Heyden]

Hello

Try this code, in a standard code module:

Please see the comments in the code too.

Public Sub DownloadFile()
    Dim rngList As Range
    Dim rngCell As Range
    Dim strPath As String
    Dim strFile As String
    Dim wkb As Workbook
    Dim pic As Picture
    Dim cht As Chart
    
    Const strPicLibrary As String = "C:\WebPics" '<- This is where the pics will be saved to
    
    Set rngList = Sheet1.Range("A10:A10") '<- Change to refer to the address of list in your spreadsheet, e.g. A1:A10
    Set wkb = Application.Workbooks.Add(xlWBATWorksheet)
    
    For Each rngCell In rngList
        strPath = rngCell.Offset(, 1).Value
        strFile = rngCell.Value & ".jpg"
        
        If Len(Dir(strPicLibrary, vbDirectory)) = 0 Then
            Call MkDir(strPicLibrary)
        End If
        
        With wkb.Sheets(1)
            Set pic = .Pictures.Insert(strPath)
            Set cht = .ChartObjects.Add(pic.Left, pic.Top, pic.Width, pic.Height).Chart
        End With
        
        pic.Copy
        
        With cht
            .Paste
            Call .Export(Filename:=strPicLibrary & "/" & strFile)
        End With
    Next rngCell

    Call wkb.Close(SaveChanges:=False)
End Sub

 

[flymeoutofhere]

Thanks for the reply!

I have an error when I try to run it. When I debug it is saying that the problem is in this line:

Call .Export(Filename:=strPicLibrary & "/" & strFile)

Is there something else I need to do?

Thanks!

 

[flymeoutofhere]

Actually I just discovered that the images were being downloaded but were being placed into new excel spreadsheets...

 

[Jon von der Heyden]

Thanks for the reply!

I have an error when I try to run it. When I debug it is saying that the problem is in this line:

Call .Export(Filename:=strPicLibrary & "/" & strFile)

Is there something else I need to do?

Thanks!

Did you update rngList to refer to the list of names you have? This should only cover the range of picture names, not the paths. The paths are expected to be in the adjacent cell on the right.

Note that in the code I have added the extension to the file name (.jpg) in order to complete strFile.

 

[flymeoutofhere]

Fantastic! It works! It was me! Thank you very much!!

 

[flymeoutofhere]

Is there any way I can adjust the size of the image being saved. At the moment , it is saving the image as about 1/3rd of the size it is at the source URL?
Thanks!

 

[Jon von der Heyden]

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.

 

[Firefly2012]

Hi

Try this:

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
 

Public Function DownloadURLtoFile(sSourceURL As String, _
sLocalFileName As String) As Boolean
 

DownloadURLtoFile = URLDownloadToFile(0&, _
    sSourceURL, sLocalFileName, &H10, 0&) = 0&

End Function

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

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

Set rngListOfURL = Sheet1.Range("A1:A10")   'amend as appropriate

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

Copy the entire contents into a standard module and run DownLoadFiles() sub.

It assumes that your range of URL in A1:A10 (as per Jon) and that in B1:B10 is the list of filenames you want to save these jpgs as. The macro places an indication of success in C1:C10 as to whether the file was downloaded or not.

You need to amend the PTH constant to wherever you wish to save the files.