Copy images files if exists to destination folder

Question

I would like scan if a folder (IMAGES) exits with image(jpg) files in it. If there are image files in that folder, then it must count the number of images and copy to a destination folder with success message . If there are no files in the folder then a message with "NO Images Found" must display.

Any help would be appreciated.

I tried below code, but it allows to select the source folder and it copies if there are images. But if there are no images, it gives ERROR. Also there is no count of images.

Sub CopyImages()    
Dim FSO As Object
Dim Path As String
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String

ChDrive "D:"
ChDir "D:\SOURCE\HTML"

Path = Application.FileDialog(msoFileDialogFolderPicker).Show
FromPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
ToPath = "D:\SOURCE\SCAN"    '<< Change
FileExt = "*.jpg"  '<< Change
'You can use *.* for all files or *.doc for word files
If Right(FromPath, 1) <> "\" Then
    FromPath = FromPath & "\"
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
    MsgBox FromPath & " Images doesn't exist"
    Exit Sub
End If
If FSO.FolderExists(ToPath) = False Then
    MsgBox ToPath & " doesn't exist"
    Exit Sub
End If
FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "Image Files Copied Successfully"
End Sub

If you select a folder you don't need FolderExists, you have to check if it contains images — patel, Mar 31 '19 at 09:19

score 1 · Accepted Answer · answered Mar 31 '19 at 10:39

Sub Copy_Images() '  dialog
    Set FSO = CreateObject("Scripting.FileSystemObject")
    InitialFoldr$ = "F:\Download"
    ToPath = "F:\Download\B"
    FileExt = "*.jpg"
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        mfolder = .SelectedItems(1)
    End With
    If Dir(mfolder & "\" & FileExt) = "" Then
        MsgBox "jpg not found", vbExclamation
        Exit Sub
    End If
    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If
    FSO.CopyFile Source:=mfolder & "\" & FileExt, Destination:=ToPath
    MsgBox "Image Files Copied Successfully"

End Sub

Hi Patel, Is it possible to have the count of images and displayed in the message — Siraj, Mar 31 '19 at 11:12
https://stackoverflow.com/questions/16753701/count-files-in-specific-folder-and-display-the-number-into-1-cel — patel, Mar 31 '19 at 11:24

score 0 · Answer 2 · answered Mar 31 '19 at 11:17

I managed to update your code and add count of images.

Sub Copy_Images() '  dialog

Dim cFileName As String
Dim cCount As Integer
Dim Path As String

Set FSO = CreateObject("Scripting.FileSystemObject")
InitialFoldr$ = "F:\Download"
ToPath = "F:\Download\B"
FileExt = "*.jpg"

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = InitialFoldr$
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    mfolder = .SelectedItems(1)
End With
If Dir(mfolder & "\" & FileExt) = "" Then
    MsgBox "jpg not found", vbExclamation
    Exit Sub
End If
If FSO.FolderExists(ToPath) = False Then
    MsgBox ToPath & " doesn't exist"
    Exit Sub
End If

Path = mfolder
cFileName = Dir(mfolder & "\" & FileExt)

Do While cFileName <> ""
cCount = cCount + 1
cFileName = Dir()
Loop 

FSO.CopyFile Source:=mfolder & "\" & FileExt, Destination:=ToPath
MsgBox cCount & " Image Files Copied Successfully"

End Sub

Copy images files if exists to destination folder

2 Answers2