Question

我想扫描文件夹（IMAGES）是否退出并包含图像（jpg）文件。如果该文件夹中有图像文件，则它必须计算图像数量并复制成功消息到目标文件夹。如果文件夹中没有文件，则必须显示“找不到图像”的消息。

任何帮助将不胜感激。

我尝试了下面的代码，但是它允许选择源文件夹，如果有图像，它将复制。但是，如果没有图像，则显示错误。此外，没有图片的数量。

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"

结束子

将图像文件复制到目标文件夹（如果存在）

2 个答案: