1

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
3
  • You got an error or something? The Directory variable isn't going to work though. Try Dim Directory as Variant Also, the name of your routine can't have spaces.
    – Skin
    Oct 22, 2022 at 3:50
  • You say: I cannot seem to get it to work. So where does the code deviate from your expectation, and how? Oct 22, 2022 at 4:30
  • Thanks. I have updated the post. For the suggested edits and clarified the problem best I can.
    – Vokey
    Oct 22, 2022 at 4:35

1 Answer 1

1

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
1
  • You're a legend! Thank you very much for this. Works like a charm.
    – Vokey
    Oct 22, 2022 at 22:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.