VBA Code to Download Images from URL's in Multiple Columns and Create/Name Folders Based On Column Values

Question

Column A has a Product Name and in column B, C, D, E, F, G,H, I, J, K, I have URL'S for images. I would like to download all the images and rename them with the product name (Column A) but adding to the file name _01, _02, _03, _04 etc. depending if the picture is from column B, C, etc and also create and add all images to folders named from Column A.

I also have 3 different file types to download, tiff's, jpeg's & pdf's, so it would be nice to download them all at the same time to the same folders.

I currently have the following code which works perfectly but it does not create the folders based on the value from column A.

What code do I need to edit to create / name the folders?

Option Explicit

Private Declare PtrSafe 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

Dim Ret As Long

'~~> This is where the images will be saved. Change as applicable
Const FolderName As String = "C:\Users\XXXXX\Desktop\images\"

Sub Sample()
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim strPath As String
    Dim c As Range, n As Long

    '~~> Name of the sheet which has the list
    Set ws = Sheets("Sheet1")

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LastRow '<~~ 2 because row 1 has headers

        n = 1
        Set c = ws.Range("B" & i)
        Do While Len(c.Value) > 0 'loop while have a URL
strPath = FolderName & ws.Range("A" & i).Value & _
                      "_" & Right("00" & n, 2) & ".tiff"

            Ret = URLDownloadToFile(0, c.Value, strPath, 0, 0)

            c.Interior.Color = IIf(Ret = 0, vbGreen, vbRed) 'success?

            Set c = c.Offset(0, 1) 'next cell to right
            n = n + 1
        Loop

    Next i
End Sub

Make `foldername` a variable rather than a constant. In the `For...Next` loop (and before the `Do...Loop` loop) change it to the name of the name of the folder you want to use for the row being processed. — DMM, Jul 31 '23 at 08:14
I appreciate your help but i am totally lost with all your comments, i have no idea about vba, i have simply copied this code from another thread and was hoping someone could give me the edited code to achieve my goal, thanks — Michael Usher, Jul 31 '23 at 08:56

score 0 · Answer 1 · answered Aug 02 '23 at 15:17

To create a folder use:

    MkDir FolderName

This will work as long as the folder does not already exist. So here is an example of putting error-handling code around the function to ignore the error that happens when the file already exists.

    On Error Resume Next
    MkDir FolderName
    On Error GoTo 0

Here is your code, modified to create the folder if it does not exist:

Option Explicit

Private Declare PtrSafe 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

Dim Ret As Long

'~~> This is where the images will be saved. Change as applicable
Const FolderName As String = "C:\Users\XXXXX\Desktop\images\"

Sub Sample()
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim strPath As String
    Dim c As Range, n As Long

    On Error Resume Next
    MkDir FolderName
    On Error GoTo 0

    '~~> Name of the sheet which has the list
    Set ws = Sheets("Sheet1")

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).row

    For i = 2 To LastRow '<~~ 2 because row 1 has headers

        n = 1
        Set c = ws.Range("B" & i)
        Do While Len(c.Value) > 0 'loop while have a URL
strPath = FolderName & ws.Range("A" & i).Value & _
                      "_" & Right("00" & n, 2) & ".tiff"

            Ret = URLDownloadToFile(0, c.Value, strPath, 0, 0)

            c.Interior.Color = IIf(Ret = 0, vbGreen, vbRed) 'success?

            Set c = c.Offset(0, 1) 'next cell to right
            n = n + 1
        Loop

    Next i
End Sub

VBA Code to Download Images from URL's in Multiple Columns and Create/Name Folders Based On Column Values

1 Answers1