Move folders using file path in excel file using VBA

Question

my goal is to move specified folders and their contents outof an existing location into a new folder path labeled "Archive". There are about 1000 folders out of 2000 I need moved to this new location. I have a .xlsx file that contains the file paths of each folder that needs moving, listed in column A of the Excel worksheet. I would like my macro to look at the Excel file, read the folder path, move that folder and its contents to a new destination. Repeat through the Excel list until it reaches a blank, then it's considered "Done!"

Here is the code I have found so far (see below). This code will move one folder from one path to another path. I need to enhance this to read each path from my Excel file; I just don't know what that part of the command should look like.

Code and any notes with the code are greatly appreciated! Thank you!

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 = "Q:\Corporate-Shares\...\Test folder 1" '<< Change
    ToPath = "Q:\Corporate-Shares\...\Test Archive 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

Answer 1

Please test this code in a test folder before working with your original files. Create copies or dummy files, any failure can damage your existing files....

First, separate this move function taking the name and destination of the path:

Sub Move_Rename_Folder(FromPath as string, ToPath as string)


    'to do these two lines, go to tools, references and add Microsoft.Scripting.Runtime 
    'it's a lot easier to work like this
    Dim fso As FileSystemObject
    Set fso = new FileSystemObject

    'you don't need to set paths anymore, they come as the arguments for this sub

    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

    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

Then, create a main Sub to run over the column "B" (from path) and Column "C" (to path), for instance:

Sub MainSub()
     Dim CurrentFrom as Range, CurrentTo as Range

     'get B2, assuming your B1 is a header, not a folder
     Set CurrentFrom = ThisWorkbook.Worksheets("yoursheetname").Range("B2")
     'get C2, assuming your C1 is a header
     Set CurrentTo = ThisWorkbook.Worksheets("yoursheetname").Range("C2")

     'get the actual values - paths - from cells
     Dim ToPath as string, FromPath as string
     ToPath = CurrentTo.value     
     FromPath = CurrentFrom.Value

     'loop while your current frompath is not empty
     Do while FromPath <> ""
         'calls the move function from frompath to topath
         Call Move_Rename_Folder(FromPath, ToPath)

         'offsets the cells one row down
         Set CurrentFrom = CurrentFrom.Offset(1,0)
         Set CurrentTo = CurrentTo.Offset(1,0)

         'gets the values of the new cells
         FromPath = CurrentFrom.Value
         ToPath = CurrentTo.Value
     Loop
End Sub