How to move a specific list of excel files to another folder using VBA-CodePudding

I am trying to copy a specific list of excel files to a destination folder. The goal is to have a macro that I can click and will allow me to select the destination folder for the defined list of files, which are then copied to the destination folder. Can you please help me with the following problem.

Current problem: Only one file from the array is being saved down in the target folder and the file type = file, not xlsm. I think has something to do with the FSO portion of the script but i am not sure what the solution is.

Sub Copyfiles_to_folder() 

Dim sSource
Dim sDest As String
Dim FSO As New FileSystemObject
Dim vYearFolder As Variant
Dim Directory as Variant

'To select destination folder with changing date
vYearFolder = BrowseForFolder("K:\FolderSource")
sDest = vYearFolder

'list of excel files that I want to be moved to the destination folder

Directory = array ("P:\file1.xlsm", "P:\file2.xlsm", "P:\file3.xlsm", "P:\file4.xlsm")

For each sSource in Directory
    FSO.CopyFile sSource, sDest, True
Next

End Sub

CodePudding user response：

Copy Files to a Folder

From the documentation

If source contains wildcard characters, or destination ends with a path separator, it is assumed that destination is an existing folder in which to copy matching files.

Sub CopyFilesToFolder()

    Const InitialDestinationFolder As String = "K:\FolderSource"
    Dim SourceFiles() As Variant: SourceFiles = Array( _
        "P:\file1.xlsm", "P:\file2.xlsm", "P:\file3.xlsm", "P:\file4.xlsm")
    
    Dim DestinationFolder As String
    DestinationFolder = PickFolder(InitialDestinationFolder)
    If Len(DestinationFolder) = 0 Then Exit Sub
    
    ' Either early binding...
    ' Needs a reference to the Microsoft Scripting Runtime library.
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    ' ... or late binding (no reference needed; no intellisense)
    'Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim n As Long
    For n = LBound(SourceFiles) To UBound(SourceFiles)
        fso.CopyFile SourceFiles(n), DestinationFolder
    Next

End Sub

Function PickFolder( _
    Optional ByVal InitialFolderPath As String = "", _
    Optional ByVal DialogTitle As String = "Browse", _
    Optional ByVal DialogButtonName As String = "OK") _
As String
    With Application.FileDialog(4) ' 4 = msoFileDialogFolderPicker
        .Title = DialogTitle
        .ButtonName = DialogButtonName
        Dim pSep As String: pSep = Application.PathSeparator
        Dim FolderPath As String
        If Len(InitialFolderPath) > 0 Then
            FolderPath = InitialFolderPath
            If Right(FolderPath, 1) <> pSep Then FolderPath = FolderPath & pSep
            .InitialFileName = FolderPath
        End If
        If .Show Then
            FolderPath = .SelectedItems(1)
            If Right(FolderPath, 1) <> pSep Then FolderPath = FolderPath & pSep
            PickFolder = FolderPath
        Else
            ' Optionally, out-comment or use a message box.
            Debug.Print "'PickFolder': Dialog canceled."
        End If
    End With
End Function