Copy Folders and Subfolders Excel VBA

Xcopy allows you to copy all folders and subfolders from a source folder to a target folder on your PC. The documentation for this code can be found on the Microsoft website: https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/xcopy

Code: (replace "C:\Users\18622\OneDrive\Desktop\Here" with the initial folder and "C:\Users\18622\OneDrive\Desktop\Move" with the folder location that you want to move to. If "C:\Users\18622\OneDrive\Desktop\Move doesn't exist, this code will create copies of the respective files, folders, and subfolders in a system created "C:\Users\18622\OneDrive\Desktop\Move anyway.)


Sub CopyFolderByCommandPrompt()
Dim SourceFolder As String, TargetFolder As String

SourceFolder = "C:\Users\18622\OneDrive\Desktop\Here"
TargetFolder = "C:\Users\18622\OneDrive\Desktop\Move"

'Copy the folder and sub folder
Call Shell("cmd.exe /c xcopy /y " & SourceFolder & " " & TargetFolder & " /E /i ")

End Sub

Sub Move_Rename_Folder()
'This example move the folder from FromPath to ToPath.
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "C:\Users\18622\OneDrive\Desktop\First folder\"  '<< Change
    ToPath = "C:\Users\18622\OneDrive\Desktop\Second folder\"    '<< Change
    'Note: It is not possible to use a folder that exist in ToPath

    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If

    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    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) = True Then
        MsgBox ToPath & " exist, not possible to move to a existing folder"
        Exit Sub
    End If

    FSO.MoveFolder Source:=FromPath, Destination:=ToPath
    MsgBox "The folder is moved from " & FromPath & " to " & ToPath

End Sub

Comments are closed.