【问题标题】:list of folder from source folders to destination folders copy vba从源文件夹到目标文件夹的文件夹列表复制vba
【发布时间】:2020-06-21 22:23:48
【问题描述】:

我有文件夹列表作为源路径和目标路径 我尝试使用以下代码,但无法理解如何在列表中逐一循环。我需要先删除目标文件夹,然后从源文件夹复制。

c:\a
c:\b
c:\c

D:\a
D:\b
d:\c

代码:

Sub Copy_Certain_Files_In_Folder()
    'This example copy all Excel files from FromPath to ToPath.
    'Note: If the files in ToPath already exist it will overwrite
    'existing files in this folder
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String

    FromPath = "C:\Users\Ron\Data"  '<< Change
    ToPath = "C:\Users\Ron\Test"    '<< Change

    FileExt = "*.xl*"  '<< Change
    'You can use *.* for all files or *.doc for Word files

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub

【问题讨论】:

    标签: excel vba directory file-management


    【解决方案1】:

    您从 Ron de Bruin 的 Excel 自动化站点复制的代码确实处理了整个文件夹。我希望您正在寻找的是一个提供包装器的循环,它首先提供对单个子文件夹的访问。然后你可以使用上面的代码并添加你的删除逻辑等。试试这个(我使用早期绑定,所以如果你还没有脚本库,请添加对脚本库的引用。):

    Option Explicit
    
    Public Sub CopyFolders(SourceFolderName As String)
    
        Dim fso As New FileSystemObject
        Dim SourceFolder As Folder
        Dim SourceSubFolder As Folder
        
        Set SourceFolder = fso.GetFolder(SourceFolderName)
        For Each SourceSubFolder In SourceFolder.SubFolders
            
            ' UPDATE AND PUT YOUR CODE TO COPY SPECIFIC FOLDERS IN HERE
            Debug.Print SourceSubFolder.Name
            
        Next
    
    End Sub
    

    参考:https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/subfolders-property

    【讨论】:

      猜你喜欢
      • 2017-03-31
      • 1970-01-01
      • 2021-06-07
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2021-03-21
      • 1970-01-01
      • 2016-03-03
      相关资源
      最近更新 更多