实现将多个文件复制到指定文件夹的按钮

Question

我正在尝试创建一个按钮，单击该按钮可让您浏览要复制到指定文件夹的文件。我有一个工作代码如下所示，但它一次只允许复制一个文件。我希望能够一次选择多个文件。我似乎无法想出一种方法来合并 dialogBox.AllowMultiSelect = True 来执行此操作。关于如何做到这一点的任何想法？谢谢。

Sub UploadFile()

Dim dialogBox As FileDialog
Dim startpath As String
Dim startname As String
Dim destinationfolder As String
Dim FSO

Set dialogBox = Application.FileDialog(msoFileDialogOpen)
Set FSO = CreateObject("Scripting.FileSystemObject")
destinationfolder = "C:\Users\John\Desktop\Images\"

dialogBox.AllowMultiSelect = False 'Do not allow multiple files to be selected
dialogBox.Title = "Select a file to upload" 'Set the title of the DialogBox
dialogBox.InitialFileName = "C:\Users\John\Desktop" 'Set the default folder to open
dialogBox.Filters.Clear 'Clear the dialog box filters

If dialogBox.Show = -1 Then 'Show the dialog box and output full file name
    startpath = dialogBox.SelectedItems(1)
End If

startname = Right(startpath, Len(startpath) - InStrRev(startpath, "\")) 'takes filename from startpath

If Not FSO.FileExists(startpath) Then 'Checking If File Is Located in the Source Folder
    MsgBox "File Not Found", vbInformation, "Not Found"
    
ElseIf Not FSO.FileExists(destinationfolder & startname) Then 'Copying If the Same File is Not Located in the Destination Folder
    FSO.CopyFile (startpath), destinationfolder, True
    MsgBox "File Uploaded Successfully", vbInformation, "Done!"
Else
    MsgBox "File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If

End Sub

Answer 1

您可以对 SelectedItems 中的每个项目进行循环：

    Dim dialogBox As FileDialog
    Dim startpath As Variant
    Dim startname As String
    Dim destinationfolder As String
    Dim FSO
    
    Set dialogBox = Application.FileDialog(msoFileDialogOpen)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    destinationfolder = "C:\Users\John\Desktop\Images\"
    
    dialogBox.AllowMultiSelect = True 'Do not allow multiple files to be selected
    dialogBox.Title = "Select a file to upload" 'Set the title of the DialogBox
    dialogBox.InitialFileName = "C:\Users\John\Desktop\" 'Set the default folder to open
    dialogBox.Filters.Clear 'Clear the dialog box filters
    If dialogBox.Show = -1 Then 'Show the dialog box and output full file name
        For Each startpath In dialogBox.SelectedItems
           Debug.Print startpath
           startname = Right(startpath, Len(startpath) - InStrRev(startpath, "\")) 'takes filename from startpath
           If Not FSO.FileExists(startpath) Then 'Checking If File Is Located in the Source Folder
                MsgBox "File Not Found (" & startpath & ")", vbInformation, "Not Found"
            ElseIf Not FSO.FileExists(destinationfolder & startname) Then 'Copying If the Same File is Not Located in the Destination Folder
                FSO.CopyFile (startpath), destinationfolder, True
                MsgBox "File Uploaded Successfully (" & startpath & ")", vbInformation, "Done!"
            Else
                MsgBox "File Already Exists In The Destination Folder (" & startpath & ")", vbExclamation, "File Already Exists"
            End If
        Next startpath
    End If

我允许多选，并使用 foreach 循环遍历每个项目（foreach 要求它的循环变量是一个变体；所以我更改了它的声明）。

我也将文件名添加到您的消息中。

实现将多个文件复制到指定文件夹的按钮

Implementing a button that copies multiple files into a specified folder

excel

vba