Implementing a button that copies multiple files into a specified folder-CodePudding

I'm trying to create a button that when clicked will let you browse for files to copy to a specified folder. I have a working code shown below but it only allows copying a single file at a time. I'd like to be able to choose multiple files at a time. I can't seem to come up with a way to incorporate dialogBox.AllowMultiSelect = True to do this. Any ideas on how to do this? Thank you.

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

CodePudding user response：

You can loop for each item in the 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

I allowed multiselect, and used a foreach loop to go through every item (foreach requires its loop variable to be a variant; so I changed its declaration).

I also added the file name to your messages.