VBA: Copy files, Delete folders

[Tan Truong]

Hello all,

I am a new member and happy to know this forum.

Here is my problem that needs help. I have multiple folders, and in each folder, I have multiple files. I want to copy these files in each folder. After that, I want to delete the folder respectively. Please see the figures below.

Please help me, thank you very much.

 

[Georgiboy]

Welcome to the forum,

Give the below a try:

Const HostFolder As String = "C:\TEST\" ' folder of folders
Dim FSO As Object

Sub sample()
    Set FSO = CreateObject("Scripting.FileSystemObject")
    DoFolder FSO.GetFolder(HostFolder)
End Sub

Private Sub DoFolder(Folder)
    Dim SubFolder, File, fp As String, fn As String, rs As String
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    For Each File In Folder.Files
        fp = File.Path
        fn = File.Name
        rs = Replace(fp, fn, "")
        If LCase(rs) = LCase(HostFolder) Then Exit Sub
        FSO.MoveFile fp, HostFolder & fn
        On Error Resume Next
            RmDir rs
        On Error GoTo 0
    Next
End Sub

 

[Tan Truong]

Welcome to the forum,

Give the below a try:

Const HostFolder As String = "C:\TEST\" ' folder of folders
Dim FSO As Object

Sub sample()
    Set FSO = CreateObject("Scripting.FileSystemObject")
    DoFolder FSO.GetFolder(HostFolder)
End Sub

Private Sub DoFolder(Folder)
    Dim SubFolder, File, fp As String, fn As String, rs As String
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    For Each File In Folder.Files
        fp = File.Path
        fn = File.Name
        rs = Replace(fp, fn, "")
        If LCase(rs) = LCase(HostFolder) Then Exit Sub
        FSO.MoveFile fp, HostFolder & fn
        On Error Resume Next
            RmDir rs
        On Error GoTo 0
    Next
End Sub

It works. Thank you so much @Georgiboy.

​

 

[Tan Truong]

Hello @Georgiboy
I want to express my gratitude for your help. The code you provided works well, but I'd like to gain a better understanding of it. Could you please take a moment to explain the code to me? Your help is greatly appreciated.

 

[Georgiboy]

Try the below annotated code:

' This line defines a constant variable named HostFolder with the value "C:\TEST\".
Const HostFolder As String = "C:\TEST\" ' folder of folders

' This line declares a variable FSO to represent a FileSystemObject.
Dim FSO As Object

' The main procedure named "sample".
Sub sample()
    ' Create a new instance of the FileSystemObject.
    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' Call the DoFolder subroutine with the root folder specified by HostFolder.
    DoFolder FSO.GetFolder(HostFolder)
End Sub

' Private subroutine named "DoFolder" that takes a Folder object as a parameter.
Private Sub DoFolder(Folder)
    Dim SubFolder, File, fp As String, fn As String, rs As String

    ' Loop through each subfolder in the specified Folder object.
    For Each SubFolder In Folder.SubFolders
        ' Recursively call the DoFolder subroutine for each subfolder.
        DoFolder SubFolder
    Next

    ' Loop through each file in the specified Folder object.
    For Each File In Folder.Files
        ' Get the full path (fp) and file name (fn) of the current file.
        fp = File.Path
        fn = File.Name

        ' Extract the path excluding the file name (rs).
        rs = Replace(fp, fn, "")

        ' Check if the path is the same as the HostFolder, LCase maces all text lower case.
        If LCase(rs) = LCase(HostFolder) Then Exit Sub

        ' Move the file to the HostFolder.
        FSO.MoveFile fp, HostFolder & fn

        ' Attempt to remove the directory (folder) that contained the moved file.
        On Error Resume Next
        RmDir rs
        On Error GoTo 0
    Next
End Sub

 

[Tan Truong]

Try the below annotated code:

' This line defines a constant variable named HostFolder with the value "C:\TEST\".
Const HostFolder As String = "C:\TEST\" ' folder of folders

' This line declares a variable FSO to represent a FileSystemObject.
Dim FSO As Object

' The main procedure named "sample".
Sub sample()
    ' Create a new instance of the FileSystemObject.
    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' Call the DoFolder subroutine with the root folder specified by HostFolder.
    DoFolder FSO.GetFolder(HostFolder)
End Sub

' Private subroutine named "DoFolder" that takes a Folder object as a parameter.
Private Sub DoFolder(Folder)
    Dim SubFolder, File, fp As String, fn As String, rs As String

    ' Loop through each subfolder in the specified Folder object.
    For Each SubFolder In Folder.SubFolders
        ' Recursively call the DoFolder subroutine for each subfolder.
        DoFolder SubFolder
    Next

    ' Loop through each file in the specified Folder object.
    For Each File In Folder.Files
        ' Get the full path (fp) and file name (fn) of the current file.
        fp = File.Path
        fn = File.Name

        ' Extract the path excluding the file name (rs).
        rs = Replace(fp, fn, "")

        ' Check if the path is the same as the HostFolder, LCase maces all text lower case.
        If LCase(rs) = LCase(HostFolder) Then Exit Sub

        ' Move the file to the HostFolder.
        FSO.MoveFile fp, HostFolder & fn

        ' Attempt to remove the directory (folder) that contained the moved file.
        On Error Resume Next
        RmDir rs
        On Error GoTo 0
    Next
End Sub

Many thanks.