List of URL Images to export and rename

K

KnightC

New Member
Joined
Jan 2, 2013
Messages
6
Hi

I have an excel sheet showing the SKU and image URL i need a way to export these to a folder on my desktop (New Folder) i understand there is a way of doing this with a macro and the ones i have found i can't seem to get to work.

The excel sheet is
Column A | Column B
SKU | ImageURL

I need the macro to change the image name to the SKU name i have about 1500 lines at the moment all different SKU names.

If anybody could help me with this i would gratefully appreciate it.

Many Thanks Craig.
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
Hi John

Thank you for this still having issues i'm not fully aware of the Macro feature so i have the following in the macro project which isn't working:

My system is the 64bit if that matters. and looking to save them in the following location C:\Desktop\Images

Code: 
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
     (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As  String, ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
    (ByVal lpszUrlName As String) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const BINDF_GETNEWESTVERSION As Long = &H10


Public Sub Download_Images()
    
    Dim lr As Long, r As Long
    Dim saveInFolder As String
    
    saveInFolder = ThisWorkbook.Path & ""
    If Right(saveInFolder, 1) <> "" Then saveInFolder = saveInFolder & "C:\Desktop\Images"
    
    With ActiveSheet
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        For r = 2 To lr
            DownloadFile .Cells(r, "B").Value, saveInFolder & .Cells(r, "A").Value & ".png"
        Next
    End With
    
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)
    If retVal = 0 Then DownloadFile = True Else DownloadFile = False

End Function
 
Upvote 0
Do you really mean C:\Desktop\Images? The Desktop folder is usually C:\Users\username\Desktop.

Try this macro, which downloads the image URLs in column B of the active sheet and saves them as the SKU in column A (with .jpg appended) to the Images subfolder on your Desktop. It creates the Images folder if it doesn't exist.

It should work for 32-bit and 64-bit Excel on 32-bit and 64-bit Windows. Put the code in a regular module - see https://www.contextures.com/xlvba01.html#videoreg if you need help with this.

Code: 
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon.dll" Alias "URLDownloadToFileA" _
    (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
    (ByVal lpszUrlName As String) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Private Declare Function URLDownloadToFile Lib "urlmon.dll" 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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const BINDF_GETNEWESTVERSION As Long = &H10


Public Sub Download_URL_Images()
    
    Dim lr As Long, r As Long
    Dim saveInFolder As String
    
    saveInFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Images"
    If Right(saveInFolder, 1) <> "" Then saveInFolder = saveInFolder & ""
    If Dir(saveInFolder, vbDirectory) = vbNullString Then
        MkDir saveInFolder
        MsgBox "Created new folder " & saveInFolder
    End If
    
    With ActiveSheet
        lr = .Cells(Rows.Count, "A").End(xlUp).row
        For r = 2 To lr
            DownloadFile .Cells(r, "B").Value, saveInFolder & .Cells(r, "A").Value & ".jpg"
        Next
    End With
    
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)
    If retVal = 0 Then DownloadFile = True Else DownloadFile = False

End Function
 
Upvote 0
Hi really sorry still having an issue can't seem to get it to work i have split the images to two separate sheets (jpn & png) and used the following codes:
PNG Images
Code: 
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon.dll" Alias "URLDownloadToFileA" _
    (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
    (ByVal lpszUrlName As String) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Private Declare Function URLDownloadToFile Lib "urlmon.dll" 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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const BINDF_GETNEWESTVERSION As Long = &H10


Public Sub Download_URL_Images()
    
    Dim lr As Long, r As Long
    Dim saveInFolder As String
    
    saveInFolder = CreateObject("WScript.Shell").SpecialFolders("C:\Users\cknight\Desktop\Hyundai_Images") & ""
    If Right(saveInFolder, 1) <> "" Then saveInFolder = saveInFolder & ""
    If Dir(saveInFolder, vbDirectory) = vbNullString Then
        MkDir saveInFolder
        MsgBox "Created new folder " & saveInFolder
    End If
    
    With ActiveSheet
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        For r = 2 To lr
            DownloadFile .Cells(r, "B").Value, saveInFolder & .Cells(r, "A").Value & ".png"
        Next
    End With
    
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)
    If retVal = 0 Then DownloadFile = True Else DownloadFile = False

End Function

JPG IMages
Code: 
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon.dll" Alias "URLDownloadToFileA" _
    (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
    (ByVal lpszUrlName As String) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Private Declare Function URLDownloadToFile Lib "urlmon.dll" 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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const BINDF_GETNEWESTVERSION As Long = &H10


Public Sub Download_URL_Images()
    
    Dim lr As Long, r As Long
    Dim saveInFolder As String
    
    saveInFolder = CreateObject("WScript.Shell").SpecialFolders("C:\Users\cknight\Desktop\Hyundai_Images") & ""
    If Right(saveInFolder, 1) <> "" Then saveInFolder = saveInFolder & ""
    If Dir(saveInFolder, vbDirectory) = vbNullString Then
        MkDir saveInFolder
        MsgBox "Created new folder " & saveInFolder
    End If
    
    With ActiveSheet
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        For r = 2 To lr
            DownloadFile .Cells(r, "B").Value, saveInFolder & .Cells(r, "A").Value & ".jpg"
        Next
    End With
    
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)
    If retVal = 0 Then DownloadFile = True Else DownloadFile = False

End Function
 
Upvote 0
When i try and put
Code: 
saveInFolder = CreateObject("WScript.Shell").SpecialFolders("C:\Users\cknight\Desktop") & "\Hyundai_Images"

It wants to create a new folder on my desktop even though there is a folder already there.
 
Upvote 0
You're calling SpecialFolders incorrectly. It should be just SpecialFolders("Desktop"), which returns "C:\Users\cknight\Desktop", and then you can append a subfolder to give the full path.

Code: 
    saveInFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Hyundai_Images\"

And the If Dir line should ensure that the Hyundai_Images subfolder is created only if it doesn't exist.

To make the macro run on both sheets for png and jpg at the same time replace the code from With ActiveSheet to End With, with the following, changing "Sheet1" to the name of the sheet for pngs and "Sheet2" to the name of the sheet for jpgs.

Code: 
    With Worksheets("Sheet1")
        lr = .Cells(Rows.Count, "A").End(xlUp).row
        For r = 2 To lr
            DownloadFile .Cells(r, "B").Value, saveInFolder & .Cells(r, "A").Value & ".png"
        Next
    End With
   
    With Worksheets("Sheet2")
        lr = .Cells(Rows.Count, "A").End(xlUp).row
        For r = 2 To lr
            DownloadFile .Cells(r, "B").Value, saveInFolder & .Cells(r, "A").Value & ".jpg"
        Next
    End With
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Insert picture with macro
Replies
7
Views
383
Akos
A
M
  • Question
Renaming images and moving to a new folde VBA
Replies
1
Views
279
John_w
J
A
  • Question
how to Image should come by entering SKU no in Excel (images are copy-paste in base file for lookup,index-match or VBA option)
Replies
1
Views
441
OaklandJim
O
A
  • Question
Help with scanning barcodes into an excel invoice
2
Replies
12
Views
596
RoryA
RoryA
J
  • Solved
Export rows to .txt
Replies
2
Views
99
jessiehayden
J

Forum statistics

Threads
1,214,866
Messages
6,121,996
Members
449,060
Latest member
mtsheetz

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top