Excel VBA: move files

Hello experts,

I am looking for a procedure in order to move files based on the following information reported in activesheet:


Error handling:
-If folders reported in column A & B don't end with "\" add the string
-If folders exists for columns A exit sub
-If folders B doesn't exist create them
-Files exist column C

If you have questions, please contact me.

Thank you very much for your help.
LVL 1
LD16Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Daniel PineaultPresident / Owner CARDA Consultants Inc.Commented:
you can use a function like http://www.devhut.net/2019/01/07/vba-move-a-file-from-one-directory-to-another/.  All you need to do is create a loop and call it repeatedly passing the values of your 2 cells.
LD16Author Commented:
Hello,

I prefer to have a short procedure.
Here is my proposal:

Sub Move_Files()
Dim Ws As Worksheet
Dim LRow As Long
Dim i As Long
Dim oldFileName As String
Dim newFileName As String
Set Ws = ActiveSheet
Dim Ans As VbMsgBoxResult

Ans = MsgBox("Before running this procedure, please check that current folder paths are reported in column A," & _
vbNewLine & " target paths in column B" & _
vbNewLine & " file name in column C (with exstension) " & _
vbNewLine & "If so, please click on Yes else click on No.", vbQuestion + vbYesNo, "Confirm Please!")
If Ans = vbNo Then Exit Sub

LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LRow
        oldFileName = .Range("A" & i).Value & .Range("C" & i).Value
        newFileName = .Range("B" & i).Value & .Range("C" & i).Value
        Name oldFileName As newFileName
   Next i
   
MsgBox ("Files have been moved")
End Sub

Open in new window


Can someone help me to add error handler in case:
-Folder reported in column A or B doesn't exist
-File name reported in column C doesn't exist
Daniel PineaultPresident / Owner CARDA Consultants Inc.Commented:
I'm confused
-Folder reported in column A or C doesn't exist
 -File name reported in column C doesn't exist
Is C a folder or a file?  Where is C coming from as originally you mentioned A and B?
Can you provide a sample workbook.

You're always better to use functions which are dedicated to individual tasks and properly error proofed than a single do all routine.  Just like in life, you can't do it all, nor should a procedure.  One way or another, you still need a FileExist and Folder Exist functions.

If I understand your code, I believe you'd need to do something more along the lines of
Sub Move_Files()
    Dim Ws                    As Worksheet
    Dim LRow                  As Long
    Dim i                     As Long
    Dim oldFileName           As String
    Dim newFileName           As String
    Dim Ans                   As Integer
    Dim bProceed              As Boolean
    On Error GoTo Error_Handler

    Set Ws = ActiveSheet

    Ans = MsgBox("Before running this procedure, please check that current folder paths are reported in column A," & _
                 vbNewLine & " target pathS in column C" & _
                 vbNewLine & " file name in column B (with exstension) " & _
                 vbNewLine & "If so, please click on Yes else click on No.", vbQuestion + vbYesNo, "Confirm Please!")
    If Ans = vbNo Then Exit Sub

    LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LRow
        bProceed = True
        'Run our checks
        If FolderExist(Ws.Range("A" & i).Value) = False Then
            MsgBox "Folder " & Ws.Range("A" & i).Value & " does not exist.", _
                   vbInformation Or vbOKOnly, "Aboarting File Move"
            bProceed = False
        End If
        If FolderExist(Ws.Range("C" & i).Value) = False Then
            MsgBox "Folder " & Ws.Range("C" & i).Value & " does not exist.", _
                   vbInformation Or vbOKOnly, "Aboarting File Move"
            bProceed = False
        End If
        If FileExist(Ws.Range("C" & i).Value & Ws.Range("B" & i).Value) = False Then
            MsgBox "File " & Ws.Range("C" & i).Value & Ws.Range("B" & i).Value & " does not exist.", _
                   vbInformation Or vbOKOnly, "Aboarting File Move"
            bProceed = False
        End If

        'Perform the actual move
        If bProceed = True Then
            oldFileName = Ws.Range("A" & i).Value & Ws.Range("B" & i).Value
            newFileName = Ws.Range("C" & i).Value & Ws.Range("B" & i).Value
            Name oldFileName As newFileName
        End If
    Next i

    MsgBox ("Files have been moved")

Error_Handler_Exit:
    On Error Resume Next
    If Not Ws Is Nothing Then Set Ws = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Move_Files" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Sub

Function FileExist(ByVal sFile As String) As Boolean
    On Error GoTo Err_Handler

    If Len(Dir(sFile)) > 0 Then
        FileExist = True
    End If

Exit_Err_Handler:
    Exit Function

Err_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: FileExist" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    GoTo Exit_Err_Handler
End Function

Function FolderExist(sFolder As String, Optional bCreateIt As Boolean = False) As Boolean
    On Error GoTo Error_Handler

    If sFolder = vbNullString Then GoTo Error_Handler_Exit
    If Dir(sFolder, vbDirectory) <> vbNullString Then
        FolderExist = True
    End If

    If FolderExist = False And bCreateIt = True Then
        MkDir sFolder
    End If

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    If Err.Number <> 52 Then
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: FolderExist" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Function

Function GetFilePath(sFile As String)
    On Error GoTo Err_Handler

    GetFilePath = Left(sFile, InStrRev(sFile, "\"))

Exit_Err_Handler:
    Exit Function

Err_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetFilePath" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    GoTo Exit_Err_Handler
End Function

Open in new window

Ensure Business Longevity with As-A-Service

Using the as-a-service approach for your business model allows you to grow your revenue stream with new practice areas, without forcing you to part ways with existing clients just because they don’t fit the mold of your new service offerings.

Bill PrewIT / Software Engineering ConsultantCommented:
I'm confused based on the following two different excerpts from your prior comments.  It's not clear to me what info is in what column so I am unable to propose a solution...

Move files reported in column A to files reported in column B

ColumnA: SourceFolder\File1.txt
ColumnB:TargetFolder\File.txt

If values reported in column A or B don't exist continue with next line with the following message: " Unable to move SourceFolder\File1.txt

Can someone help me to add error handler in case:
-Folder reported in column A or B doesn't exist
-File name reported in column C doesn't exist


»bp
LD16Author Commented:
Hello,
My mistake I revised the questions, please take a look again.
LD16Author Commented:
@Daniel Pineault: thank you very much for your useful advices.
I readapt your procedure as I was wrong with columns specifications.

Sub Move_Files()
    Dim Ws                    As Worksheet
    Dim LRow                  As Long
    Dim i                     As Long
    Dim oldFileName           As String
    Dim newFileName           As String
    Dim Ans                   As Integer
    Dim bProceed              As Boolean
    On Error GoTo Error_Handler

    Set Ws = ActiveSheet

    Ans = MsgBox("Before running this procedure, please check that" & _
                 vbNewLine & "Source folder is reported in column A," & _
                 vbNewLine & "Target folder in column B" & _
                 vbNewLine & "File name in column C (with exstension) " & _
                 vbNewLine & "If so, please click on Yes else click on No.", vbQuestion + vbYesNo, "Confirm Please!")
    If Ans = vbNo Then Exit Sub

    LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LRow
        bProceed = True
        'Run our checks
        If FolderExist(Ws.Range("A" & i).Value) = False Then
            MsgBox "Folder " & Ws.Range("A" & i).Value & " does not exist.", _
                   vbInformation Or vbOKOnly, "Aboarting File Move"
            bProceed = False
        End If
        If FolderExist(Ws.Range("B" & i).Value) = False Then
            MsgBox "Folder " & Ws.Range("B" & i).Value & " does not exist.", _
                   vbInformation Or vbOKOnly, "Aboarting File Move"
            bProceed = False
        End If
        If FileExist(Ws.Range("A" & i).Value & Ws.Range("C" & i).Value) = False Then
            MsgBox "File " & Ws.Range("B" & i).Value & Ws.Range("C" & i).Value & " does not exist.", _
                   vbInformation Or vbOKOnly, "Aboarting File Move"
            bProceed = False
        End If

        'Perform the actual move
        If bProceed = True Then
            oldFileName = Ws.Range("A" & i).Value & Ws.Range("C" & i).Value
            newFileName = Ws.Range("B" & i).Value & Ws.Range("C" & i).Value
            Name oldFileName As newFileName
        End If
    Next i

    MsgBox ("Files have been moved")

Error_Handler_Exit:
    On Error Resume Next
    If Not Ws Is Nothing Then Set Ws = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Move_Files" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Sub
'Use in procedure Move_Files
Function FileExist(ByVal sFile As String) As Boolean
    On Error GoTo Err_Handler

    If Len(Dir(sFile)) > 0 Then
        FileExist = True
    End If

Exit_Err_Handler:
    Exit Function

Err_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: FileExist" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    GoTo Exit_Err_Handler
End Function
'Use in procedure Move_Files
Function FolderExist(sFolder As String, Optional bCreateIt As Boolean = False) As Boolean
    On Error GoTo Error_Handler

    If sFolder = vbNullString Then GoTo Error_Handler_Exit
    If Dir(sFolder, vbDirectory) <> vbNullString Then
        FolderExist = True
    End If

    If FolderExist = False And bCreateIt = True Then
        MkDir sFolder
    End If

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    If Err.Number <> 52 Then
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: FolderExist" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Function
'Use in procedure Move_Files
Function GetFilePath(sFile As String)
    On Error GoTo Err_Handler

    GetFilePath = Left(sFile, InStrRev(sFile, "\"))

Exit_Err_Handler:
    Exit Function

Err_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetFilePath" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    GoTo Exit_Err_Handler
End Function

Open in new window


I tested and it works. The only think that can be revised is that I am forced to put "\" at the end of the folder. Possible to avoid this through the procedure.
LD16Author Commented:
@Bill: if you have a shortest procedure to manage this don't hesitate to post it as I am interesting if this can be manage with another approach.
Bill PrewIT / Software Engineering ConsultantCommented:
How about something like this:

Sub Move_Files()
    Dim Ws As Worksheet
    Dim LRow As Long
    Dim i As Long
    Dim FromDir As String
    Dim ToDir As String
    Dim FileName As String
    Dim Ans As Int
    Dim MsgTxt As String
    Dim FSO As Object

    MsgTxt = "Before running this procedure, please check that current folder paths are reported in column A,"
    MsgTxt = MsgTxt & vbNewLine & " target paths in column B"
    MsgTxt = MsgTxt & vbNewLine & " file name in column C (with exstension) "
    MsgTxt = MsgTxt & vbNewLine & "If so, please click on Yes else click on No."

    Ans = MsgBox(MsgTxt, vbQuestion + vbYesNo, "Confirm Please!")
    If Ans = vbNo Then Exit Sub

    Set FSO = = CreateObject("Scripting.FileSystemObject")

    LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LRow
        FromDir = Ws.Range("A" & i).Value
        ToDir = Ws.Range("B" & i).Value
        FileName = Ws.Range("C" & i).Value

        If Right(FromDir, 1) <> "\" Then FromDir = FromDir & "\"
        If Right(ToDir, 1) <> "\" Then ToDir = ToDir & "\"

        If Not FSO.DirectoryExists(FromDir) Then
            MsgBox "Folder does not exist : " & FromDir
            Exit Sub
        End If

        If Not FSO.DirectoryExists(ToDir) Then
            MsgBox "Folder does not exist : " & ToDir
            Exit Sub
        End If

        If Not FSO.FileExists(FromDir & FileName) Then
            MsgBox "File does not exist : " & FromDir & FileName
            Exit Sub
        End If

        If FSO.FileExists(ToDir & FileName) Then
            MsgBox "File already exists : " & ToDir & FileName
            Exit Sub
        End If

        FSO.MoveFile FromDir & FileName, ToDir & FileName
    Next i
       
    MsgBox ("Files have been moved")
End Sub

Open in new window


»bp
LD16Author Commented:
Hello Bill,

I tested your proposal however there are some little issues with the variable declaration and set Ws it not reported.

Here the revised version:

Sub Move_Files()
    Dim Ws As Worksheet
    Dim LRow As Long
    Dim i As Long
    Dim FromDir As String
    Dim ToDir As String
    Dim FileName As String
    Dim Ans As Integer
    Dim MsgTxt As String
    Dim FSO As Object
    
    Set Ws = ActiveSheet

    MsgTxt = "Before running this procedure, please check that current folder paths are reported in column A,"
    MsgTxt = MsgTxt & vbNewLine & " target paths in column B"
    MsgTxt = MsgTxt & vbNewLine & " file name in column C (with exstension) "
    MsgTxt = MsgTxt & vbNewLine & "If so, please click on Yes else click on No."

    Ans = MsgBox(MsgTxt, vbQuestion + vbYesNo, "Confirm Please!")
    If Ans = vbNo Then Exit Sub

    Set FSO = CreateObject("Scripting.FileSystemObject")

    LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LRow
        FromDir = Ws.Range("A" & i).Value
        ToDir = Ws.Range("B" & i).Value
        FileName = Ws.Range("C" & i).Value

        If Right(FromDir, 1) <> "\" Then FromDir = FromDitr & "\"
        If Right(ToDir, 1) <> "\" Then ToDir = ToDir & "\"

        If Not FSO.DirectoryExists(FromDir) Then
            MsgBox "Folder does not exist : " & FromDir
            Exit Sub
        End If

        If Not FSO.DirectoryExists(ToDir) Then
            MsgBox "Folder does not exist : " & ToDir
            Exit Sub
        End If

        If Not FSO.FileExists(FromDir & FileName) Then
            MsgBox "File does not exist : " & FromDir & FileName
            Exit Sub
        End If

        If FSO.FileExists(ToDir & FileName) Then
            MsgBox "File already exists : " & ToDir & FileName
            Exit Sub
        End If

        FSO.MoveFile FromDir & FileName, ToDir & FileName
    Next i
       
    MsgBox ("Files have been moved")
End Sub

Open in new window


When I run revised version I have a problem as reported bellow:
2019-03-24_10h49_25.png2019-03-24_10h49_31.png
Microsoft Scripting Runtime library is active.
Thank you in advance for your help.
Bill PrewIT / Software Engineering ConsultantCommented:
Sorry, DirectoryExists should be FolderExists, as in below.  You can always check the methods and properties of the FileSystemObject at this reference to quickly work through these kind of errors.


Sub Move_Files()
    Dim Ws As Worksheet
    Dim LRow As Long
    Dim i As Long
    Dim FromDir As String
    Dim ToDir As String
    Dim FileName As String
    Dim Ans As Integer
    Dim MsgTxt As String
    Dim FSO As Object
    
    Set Ws = ActiveSheet

    MsgTxt = "Before running this procedure, please check that current folder paths are reported in column A,"
    MsgTxt = MsgTxt & vbNewLine & " target paths in column B"
    MsgTxt = MsgTxt & vbNewLine & " file name in column C (with exstension) "
    MsgTxt = MsgTxt & vbNewLine & "If so, please click on Yes else click on No."

    Ans = MsgBox(MsgTxt, vbQuestion + vbYesNo, "Confirm Please!")
    If Ans = vbNo Then Exit Sub

    Set FSO = CreateObject("Scripting.FileSystemObject")

    LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LRow
        FromDir = Ws.Range("A" & i).Value
        ToDir = Ws.Range("B" & i).Value
        FileName = Ws.Range("C" & i).Value

        If Right(FromDir, 1) <> "\" Then FromDir = FromDitr & "\"
        If Right(ToDir, 1) <> "\" Then ToDir = ToDir & "\"

        If Not FSO.FolderExists(FromDir) Then
            MsgBox "Folder does not exist : " & FromDir
            Exit Sub
        End If

        If Not FSO.FolderExists(ToDir) Then
            MsgBox "Folder does not exist : " & ToDir
            Exit Sub
        End If

        If Not FSO.FileExists(FromDir & FileName) Then
            MsgBox "File does not exist : " & FromDir & FileName
            Exit Sub
        End If

        If FSO.FileExists(ToDir & FileName) Then
            MsgBox "File already exists : " & ToDir & FileName
            Exit Sub
        End If

        FSO.MoveFile FromDir & FileName, ToDir & FileName
    Next i
       
    MsgBox ("Files have been moved")
End Sub

Open in new window


»bp

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LD16Author Commented:
Thank you Bill for this proposal.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.