如何使用VBA將特定的excel檔案串列移動到另一個檔案夾-有解無憂

我正在嘗試將特定的 excel 檔案串列復制到目標檔案夾。目標是擁有一個可以單擊的宏，并允許我為已定義的檔案串列選擇目標檔案夾，然后將其復制到目標檔案夾。你能幫我解決以下問題嗎？

當前問題：陣列中只有一個檔案保存在目標檔案夾中，并且檔案型別 = 檔案，而不是 xlsm。我認為這與腳本的 FSO 部分有關，但我不確定解決方案是什么。

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

uj5u.com熱心網友回復：

將檔案復制到檔案夾

來自documentation

如果 source 包含通配符，或者destination 以路徑分隔符結尾，則假定destination 是要在其中復制匹配檔案的現有檔案夾。

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

轉載請註明出處，本文鏈接：https://www.uj5u.com/net/520831.html

標籤：擅长vba文件目录

上一篇：如何從c#中的txt檔案中找到x,y的索引？蛇游戲

下一篇：多次寫入的PHP檔案鎖定問題