Data feed with web address to pictures

[scubajj]

Hello,

I have an excel data feed that has http://xxx. xxx is a link to individual pictures. I need to download these picture and save them as a jpg and change the file name as well. I have a database with about 2000 items. Can this be done?

Thanks
JJ

 

[scubajj]

1

 

[John_w]

You could use URLDownloadToFile (a Windows API function).

 

[scubajj]

Thank you John, can you elaborate?

 

[John_w]

Have you searched? This forum and/or Google have many examples.

 

[scubajj]

I have but it looks like code and maybe its too much for my skill set.

 

[John_w]

Try this code for a start. I've assumed that the image URLs are in column A, starting at row 2. The images are downloaded to the folder defined by the 'downloadToFolder' variable, and this folder and all intermediate folders must exist. The images aren't renamed (please explain exactly how you want them to be renamed), but are saved with the original file name from the URL.

Put the code in a new module in your workbook containing the image URLs, and run the Download_All_Images macro with the sheet containing the image URLs (in column A) as the active sheet.

Option Explicit


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
  
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
    (ByVal lpszUrlName As String) As Long
  
Private Const BINDF_GETNEWESTVERSION As Long = &H10



Public Sub Download_All_Images()

    Dim downloadToFolder As String
    Dim lastRow As Long
    Dim URL As Variant
    Dim FileName As String
    
    downloadToFolder = "C:\Temp\Excel\images\"          'THIS FOLDER MUST EXIST
    
    If Right(downloadToFolder, 1) <> "\" Then downloadToFolder = downloadToFolder & "\"
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For Each URL In Range("A2:A" & lastRow)
        FileName = downloadToFolder & Mid(URL, InStrRev(URL, "/") + 1)
    
        If Not DownloadFile(CStr(URL), FileName) Then
            MsgBox "Error downloading " & URL & " to " & FileName
        End If
    Next
    
End Sub


Private Function DownloadFile(URL As String, LocalFileName As String) As Boolean
    
    Dim RetVal As Long
    
    DeleteUrlCacheEntry URL
    RetVal = URLDownloadToFile(0, URL, LocalFileName, BINDF_GETNEWESTVERSION, 0)
    DownloadFile = (RetVal = 0)

End Function

 

[scubajj]

John,

Wow! I cant thank you enough. I am running the macro and it seems to be doing great! As far as the renaming, I wanted to rename the files to what was in columb B.

 

[John_w]

I wanted to rename the files to what was in columb B.

How does the code know what was in column B?

 

[scubajj]

John,

Thats what I was wondering, is it possible to download from column a and rename the file to what was in column B?