CODEWITHSUNDEEP
excelvba
Jacek Michalski
Jacek Michalski

Reputation: 55

Download pictures from url and save in a folder named by a cell

I have a worksheet with folder names, image names and urls. I want to download each image to the specific folder so that the outcome would look like this: 

Folder Name   Image Name     URL
-----------   ------------   -----------------------------------
folder1      image1         http://www.example.com/example1.jpg
folder2      image2         http://www.example.com/example2.jpg
folder3      image3         http://www.example.com/example3.jpg
folder4      image4         http://www.example.com/example4.jpg
folder5      image5         http://www.example.com/example5.jpg

C:\images\folder1\image1.jpg
C:\images\folder2\image2.jpg
C:\images\folder3\image3.jpg
C:\images\folder4\image4.jpg
C:\images\folder5\image5.jpg

I've found this VBA code and it works like a charm, but I don't know how to add a method to creat folders if they don't exist:

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

Dim Ret As Long

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

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

    '~~> 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
        strPath = FolderName & ws.Range("A" & i).Value & ".jpg"

        Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0)

        If Ret = 0 Then
            ws.Range("C" & i).Value = "File successfully downloaded"
        Else
            ws.Range("C" & i).Value = "Unable to download the file"
        End If
    Next i
End Sub

Upvotes: 4

Views: 30814

Answers (2)

bmwjohnno
bmwjohnno

Reputation: 11

I found some errors in the original VBA Code. Here is an update.

    For i = 2 To LastRow '<~~ 2 because row 1 has headers
        strPath = FolderName & ws.Range("A" & i).value & "\" & ws.Range("B" & i).Value & ".jpg" 
'edit strPath = FolderName & ws.Range("A" & i).Value & ".jpg" to strPath = FolderName & ws.Range("A" & i) ***& "\" & ws.Range("B" & i)***.Value & ".jpg"
        If Len(Dir(FolderName & ws.Range("A" & i) & "\", vbDirectory)) = 0 Then
            MkDir FolderName
        End If
        Ret = URLDownloadToFile(0, ws.Range("C" & i).Value, strPath, 0, 0)
'edit Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0) to Ret = URLDownloadToFile(0, ***ws.Range("C" & i)***.Value, strPath, 0, 0)
  1. The Image Name is actually in Column B and needs to be added to the path
  2. The URL is actually in Column C

Upvotes: 1

Jimmy Smith
Jimmy Smith

Reputation: 2451

The following will determine if a folder exists, and if not, create it:

If Len(Dir(FolderName, vbDirectory)) = 0 Then
   MkDir FolderName
End If

Modified from here

For anything more advanced, I recommend using the FileSystemObject classes.

Upvotes: 4

Related Questions