VB Script to Read Cells in Column A and Check if Folder Exists and if So Copy if not display message and move onto next cell

[NBoudreault]

I have created a macro enabled workbook with the below script. Currently I have folders 1,2,3, in a "Source" directory and my destination is empty. If I enter into Column A on my work book 1,2 it will copy folders 1 and 2 no issue and tell me process complete. When I then list in Column A 1,2,4,3 instead of receiving a message boxes indicating "1 and 2 already exist" and then another with "4 not Found" and then moving on to copy folder 3 the script will produce the message boxes but it never will go on to Copy folder 3. I want to inform users using this spreadsheet when they plug the folders they are looking for in that the folders don't exist but it should proceed forward with finding and copying the folders it can find. Also the below script is my last working iteration but I do get a debug where it cannot locate a folder it errors out indicating that the copy failed as it cannot locate the folder. I do have other versions which move forward and do not debug this is just my latest version that I was messing with in order to get the script to continue reading down column A regardless if it finds a folder, doesn't find a folder or if the folder is already present in the destination. I am open to an output file that informs users of the output results if thats a better way but I would prefer to alert users mid-processing that the copy was not possible for whatever reason.

Script:
Sub Move_Rename_Folder()
'This script copies the folders listed in the excel spreadsheet from FromPath to ToPath.
Dim FSO As Object
Dim FPath As String
Dim FromPath As String
Dim TPath As String
Dim ToPath As String
Dim CV As String

Dim i As Long
For i = 2 To 10

FPath = "C:\Users\NBoudreault\Desktop\Test\Source" 'Path where folders are located
FromPath = FPath & "\" & Sheets(1).Cells(i, 1)
TPath = "C:\Users\NBoudreault\Desktop\Test\Destination" 'Path where folders will be copied to
ToPath = TPath & "\" & Sheets(1).Cells(i, 1)
CV = Sheets(1).Cells(i, 1)

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

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

Set FSO = CreateObject("scripting.filesystemobject")

If CV = Empty Then
GoTo Complete
Else: End If

If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist in Account Directory"
End If

If FSO.FolderExists(ToPath) = True Then
MsgBox FromPath & " Already Exists"
End If

FSO.CopyFolder Source:=FromPath, Destination:=ToPath

Next

Complete:
MsgBox "Processing Completed"

End Sub

 

[I_know_nuffin]

Try the below

Sub Move_Rename_Folder()
'This script copies the folders listed in the excel spreadsheet from FromPath to ToPath.
Dim FSO As Object
Dim FPath As String
Dim FromPath As String
Dim TPath As String
Dim ToPath As String
Dim CV As String
Dim i As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 2 To 10
FPath = "C:\Users\NBoudreault\Desktop\Test\Source" 'Path where folders are located

FromPath = FPath & "\" & Sheets(12).Cells(i, 1)
TPath = "C:\Users\NBoudreault\Desktop\Test\Destination" 'Path where folders will be copied to

ToPath = TPath & "\" & Sheets(12).Cells(i, 1)


CV = Sheets(12).Cells(i, 1)

If CV = Empty Then
Exit For ' comment this out if you expect empty rows
         ' so you can move to next row (next i in the for loop)

Else

If FSO.FolderExists(FromPath) = False Then
    MsgBox FromPath & " doesn't exist in Account Directory"
Else

    Debug.Print "FromPath = " & FromPath
    Debug.Print

    If FSO.FolderExists(ToPath) = True Then
        MsgBox ToPath & " Already Exists"
    Else
        Debug.Print "ToPath = " & ToPath
        Debug.Print

        FSO.CopyFolder FromPath, ToPath, True

    End If ' topath already exists
    
End If ' frompath doesnt exist

End If ' CV = Empty
Next

MsgBox "Processing Completed"

End Sub

 

[NBoudreault]

Thank you for the most part that worked I had to make some minor changes but its working as intended so I very much appreciate your help!!!!!