Copy Multiple Files To New Destination

So I was just playing around to see IF I can copy multiple files to a new location and I have got it working. The only problem with my code is you have to select the destination first. When I put the folder selection after the file selection it prompts me for a new destination for each file I have selected. How can I do this where I can select the files and then choose the destination? A HUGE thanks goes out to Helen Feddema for posting code that I could piece together.

 

Public Function SelectFile() As String
'Requires Office XP (2002) or higher
'Requires a reference to the Microsoft Office Object Library
'Created by Helen Feddema 3-Aug-2009
'Last modified 3-Aug-2009
'
'On Error GoTo ErrorHandler

   Dim fd As Office.FileDialog
   Dim varSelectedItem As Variant
   Dim strFileNameAndPath As String
    Dim strFolderPath As String
   Dim fds As Office.FileDialog
   Dim strPath As String
   Dim SelectFolder As String
   
   
   'Create a FileDialog object as a File Picker dialog box.
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   Set fds = Application.FileDialog(msoFileDialogFolderPicker)
   
   
      strPath = "c:\"

   With fds
      .Title = "Browse for folder where _________ are located"
      .ButtonName = "Select"
      .InitialView = msoFileDialogViewDetails
      '.InitialFileName = strPath
      If .Show = -1 Then
         strFolderPath = CStr(fd.SelectedItems.Item(1)) & "\"
      Else
         Debug.Print "User pressed Cancel"
         strFolderPath = ""
      End If
   End With
   
   SelectFolder = strFolderPath
   MsgBox SelectFolder
   
   
      Set fd = Application.FileDialog(msoFileDialogFilePicker)
   With fd
      'Set AllowMultiSelect to True to allow selection of multiple files
      .AllowMultiSelect = True
      
      .Title = "Browse for File"
      .ButtonName = "Select"
      .Filters.Clear
      .Filters.Add "Documents", "*.*", 1
'       .Filters.Add "Documents", "*.doc; *.txt", 1
      .InitialView = msoFileDialogViewDetails
      If .Show = -1 Then
         'Get selected item in the FileDialogSelectedItems collection
         For Each varSelectedItem In .SelectedItems
            strFileNameAndPath = CStr(varSelectedItem)
            Dim FileNameWithExt
            FileNameWithExt = Mid$(strFileNameAndPath, InStrRev(strFileNameAndPath, "\") + 1)
    
'            MsgBox FileNameWithExt
'            MsgBox varSelectedItem
'            MsgBox strFileNameAndPath
'            MsgBox SelectFolder
           FileCopy varSelectedItem, SelectFolder & FileNameWithExt
'
           
         Next varSelectedItem
        
         
      Else
         Debug.Print "User pressed Cancel"
         strFileNameAndPath = ""
      End If
   End With
   
   SelectFile = strFileNameAndPath
  
   
'ErrorHandlerExit:
'   Set fd = Nothing
'   Exit Function
'
'ErrorHandler:
'   MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
'   Resume ErrorHandlerExit

End Function

Select all Open in new window

Thanks for any help on this.