Скопируйте файлы изображений, если они существуют, в целевую папку

Question

Я хотел бы сканировать, если папка (ИЗОБРАЖЕНИЯ) выходит с файлами изображений (jpg) в ней.Если в этой папке есть файлы изображений, он должен посчитать количество изображений и скопировать их в целевую папку с сообщением об успехе.Если в папке нет файлов, то должно появиться сообщение «NO Images Found».

Любая помощь приветствуется.

Я попробовал код ниже, но он позволяет выбрать источникпапка и копирует, если есть изображения.Но если нет изображений, это дает ОШИБКУ.Также нет количества изображений.

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

Answer 1

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

Answer 2

Мне удалось обновить ваш код и добавить количество изображений.

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