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

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:UsersJohnDesktopImages"
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:UsersJohnDesktop" '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:UsersJohnDesktopImages"

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:UsersJohnDesktop" '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

我允许multiselect，并使用foreach循环遍历每个项目(foreach要求它的循环变量是一个变体;所以我改变了它的声明)。

我还在你的留言中添加了文件名。