We help IT Professionals succeed at work.

Excel VBA: rename files / problems with files exist function

Hello experts,

I have the following procedure which allows me to rename files. I don’t understand why I am not able to execute it when a source file has the following name: test - BS 01 2020 (testé(e)s) 8.pdf

Sub Rename_Files()

 Dim SourceFolder As String, TargetFolder As String, SourceFile As String, TargetFile As String
 Dim MsgTxt As String
 Dim ErrorsFound As Boolean

 On Error GoTo Error_Routine

 Set oWS = ActiveSheet
 Set fso = CreateObject("Scripting.FileSystemObject")

 lRw = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
 oWS.Range("D2:D" & lRw).Clear
 
 MsgTxt = "Before running this procedure, make sure to report following information as of row 2:"
 MsgTxt = MsgTxt & vbNewLine & " 1-Column A: Source path directory"
 MsgTxt = MsgTxt & vbNewLine & " 2-Column B: Source file with extension"
 MsgTxt = MsgTxt & vbNewLine & " 3-Column C: Target file with extension"

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

 ErrorsFound = False

 For i = 2 To lRw
 SourceFolder = oWS.Range("A" & i).Value
 SourceFile = oWS.Range("B" & i).Value
 TargetFile = oWS.Range("C" & i).Value

 'Check if folder end with \. If not create it
 If Right(SourceFolder, 1) <> Application.PathSeparator Then SourceFolder = SourceFolder & Application.PathSeparator

 'Check if folder exist
 If Dir(SourceFolder, vbDirectory) = vbNullString Then
 oWS.Cells(i, 4).Value = "From folder does not exist."
 oWS.Cells(i, 4).Font.Color = vbRed
 ErrorsFound = True
 End If

 'Check if source files exist
 If Not FileExist(SourceFolder & SourceFile) Then
 oWS.Cells(i, 4).Value = "From file does not exist."
 oWS.Cells(i, 4).Font.Color = vbRed
 ErrorsFound = True
 End If

 'Check if target files exist
 If FileExist(SourceFolder & TargetFile) Then
 oWS.Cells(i, 4).Value = "To file already exists."
 oWS.Cells(i, 4).Font.Color = vbRed
 ErrorsFound = True
 End If

 Name SourceFolder & SourceFile As SourceFolder & TargetFile
 oWS.Cells(i, 4).Value = "File renamed."
 oWS.Cells(i, 4).Font.Color = vbGreen
 Next i
 
 If ErrorsFound Then
 MsgBox ("ERRORS OCCURED, check detail status on each line.")
 Else
 MsgBox ("Files have been processed with no errors.")
 End If
 
 Exit Sub
Error_Routine:
 MsgBox Err.Description, vbExclamation, "Something went wrong!" & _
 vbNewLine & " Unable to proceed, please check the consistency of data reported (ie: file name with extension) or if file to rename is opened."
 
 End Sub

Open in new window


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

 If Len(Dir(sFile)) > 0 Then FileExist = True
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

Open in new window



How should I modify the function FileExist to allows to rename files which really exist?

Thank you for your help.
Comment
Watch Question

Fabrice LambertConsulting
CERTIFIED EXPERT
Distinguished Expert 2017

Commented:
Throw the Dir function to garbage, it is a source of troubles.
Use the file system Library instead:
Public Function FileExist(ByVal pat As String) As Boolean
    Dim fso As Object       '// Scripting.FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    FileExist = fso.FileExists(Path)
End Function

Open in new window

Luis DiazIT consultant

Author

Commented:
Thank you.
What about the error handler of the previous version of the function?
Fabrice LambertConsulting
CERTIFIED EXPERT
Distinguished Expert 2017

Commented:
By looking at your first post, I assume that you are french speaking, and probably own a french system.

After running the following test:
List files from the "Mes documents" folder with the Dir function, an error is thrown.

So, I can only guess there are some path the Dir function do not accept, thus making your FileExist function returning false while the file is present.
In concequences, the name function fail.

And this is another reason why I do not recommend to use the Dir function (it also do not support recursivity very well) neither old VBA file system operations, unless you're dealing with binary files (no choices).
The File System Library is far superior and should be your prime choice when dealing with the file system.

Additional notes:
Your FileExist function is bad.
First, it break the Single Responsibility Principle (displaying a message is not its job).
2nd, it break the error handling flow. By intercepting the error and not re-throwing it, the calling function(s) have no chance to know something went wrong and cannot react accordingly.
Excel & VBA Expert
CERTIFIED EXPERT
Most Valuable Expert 2018
Awarded 2015
Commented:

You already created a filesystemobject in your main routine and you can utilize it to check whether a folder or a file exists or not instead of declaring a separate function to do so.


Another point is, always have Option Explicit on top of the module so that you know each variable is declared properly as it's not a good practice to use a variable without actually declaring it.


Try this to see if this works as desired now.

Sub Rename_Files()
    
Dim fso             As Object
Dim oWS             As Worksheet
Dim SourceFolder    As String
Dim TargetFolder    As String
Dim SourceFile      As String
Dim TargetFile      As String
Dim lRw             As Long
Dim i               As Long
Dim MsgTxt          As String
Dim ErrorsFound     As Boolean
Dim Ans             As VbMsgBoxResult

On Error GoTo Error_Routine

Set oWS = ActiveSheet
Set fso = CreateObject("Scripting.FileSystemObject")

lRw = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
oWS.Range("D2:D" & lRw).Clear

MsgTxt = "Before running this procedure, make sure to report following information as of row 2:"
MsgTxt = MsgTxt & vbNewLine & " 1-Column A: Source path directory"
MsgTxt = MsgTxt & vbNewLine & " 2-Column B: Source file with extension"
MsgTxt = MsgTxt & vbNewLine & " 3-Column C: Target file with extension"
MsgTxt = MsgTxt & vbNewLine & vbNewLine & "If all is good, click on Yes to Continue or click on No to Exit."
Ans = MsgBox(MsgTxt, vbQuestion + vbYesNo, "Confirm Please!")

If Ans = vbNo Then Exit Sub

For i = 2 To lRw
    ErrorsFound = False
    SourceFolder = oWS.Range("A" & i).Value
    SourceFile = oWS.Range("B" & i).Value
    TargetFile = oWS.Range("C" & i).Value
    
    'Check if folder end with \. If not create it
    If Right(SourceFolder, 1) <> Application.PathSeparator Then SourceFolder = SourceFolder & Application.PathSeparator
    
    'Check if folder exist
    If Not fso.folderexists(SourceFolder) Then
        oWS.Cells(i, 4).Value = "From folder does not exist."
        oWS.Cells(i, 4).Font.Color = vbRed
        ErrorsFound = True
    End If
    
    'Check if source files exist
    If Not fso.fileexists(SourceFolder & SourceFile) Then
        oWS.Cells(i, 4).Value = "From file does not exist."
        oWS.Cells(i, 4).Font.Color = vbRed
        ErrorsFound = True
    End If
    
    'Check if target files exist
    If fso.fileexists(SourceFolder & TargetFile) Then
        oWS.Cells(i, 4).Value = "To file already exists."
        oWS.Cells(i, 4).Font.Color = vbRed
        ErrorsFound = True
    End If
    
    If Not ErrorsFound Then
        Name SourceFolder & SourceFile As SourceFolder & TargetFile
        oWS.Cells(i, 4).Value = "File renamed."
        oWS.Cells(i, 4).Font.Color = vbGreen
    End If
Next i

If ErrorsFound Then
    MsgBox ("ERRORS OCCURED, check detail status on each line.")
Else
    MsgBox ("Files have been processed with no errors.")
End If

Exit Sub
Error_Routine:
MsgBox Err.Description, vbExclamation, "Something went wrong!" & _
vbNewLine & " Unable to proceed, please check the consistency of data reported (ie: file name with extension) or if file to rename is opened."

End Sub
Luis DiazIT consultant

Author

Commented:
Thank you Subodh, I will test it and let you know.
Luis DiazIT consultant

Author

Commented:
Subodh,

I tested and it works!

Concerning option explicit, I already have on top of my module part of my xlam file. I forgot to report it in the question.

Thank you very much for your help!
Subodh Tiwari (Neeraj)Excel & VBA Expert
CERTIFIED EXPERT
Most Valuable Expert 2018
Awarded 2015

Commented:

You're welcome Luis! Glad it worked as desired.

I am not sure how you could run the original code with Option Explicit on top of the module as some variables were not declared. If you compare both the codes, you will find that I declared some variables which were not declared in the original code.

Fabrice LambertConsulting
CERTIFIED EXPERT
Distinguished Expert 2017

Commented:
Side notes:
This can be simplified:
The FileSystemObject Library handle the folder separator (/ or \) without problems. So checking if it is present is useless.
    Dim fso As object        '// Scripting.FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Debug.Print fso.FolderExists("c:\windows")    '// return True
    Debug.Print fso.FolderExists("c:\windows\")   '// return True
    Debug.Print fso.FolderExists("c:/windows")    '// return True
    Debug.Print fso.FolderExists("c:/windows/")   '// return True

Open in new window

Luis DiazIT consultant

Author

Commented:
@Subodh:

This is the block which I used on top of the module.
'***************************************************************************
'DIM DECLARATION
'***************************************************************************
Option Explicit
'Variables to be used by any Procedure
Dim oWS As Worksheet, oWB As Workbook
Dim rCl As Range, rRng As Range, uRng As Range
Dim col As Long, lRw As Long, i As Long
Dim Val As String, sFldr As String, sFil As String, sPath As String, FolderCreationTime As String
Dim Ans As Integer
Dim fso As Object
'***************************************************************************

Open in new window


and this is your proposal:
Sub Rename_Files()
    
Dim fso             As Object
Dim oWS             As Worksheet
Dim SourceFolder    As String
Dim TargetFolder    As String
Dim SourceFile      As String
Dim TargetFile      As String
Dim lRw             As Long
Dim i               As Long
Dim MsgTxt          As String
Dim ErrorsFound     As Boolean
Dim Ans             As VbMsgBoxResult

On Error GoTo Error_Routine

Set oWS = ActiveSheet
Set fso = CreateObject("Scripting.FileSystemObject")

lRw = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
oWS.Range("D2:D" & lRw).Clear

MsgTxt = "Before running this procedure, make sure to report following information as of row 2:"
MsgTxt = MsgTxt & vbNewLine & " 1-Column A: Source path directory"
MsgTxt = MsgTxt & vbNewLine & " 2-Column B: Source file with extension"
MsgTxt = MsgTxt & vbNewLine & " 3-Column C: Target file with extension"
MsgTxt = MsgTxt & vbNewLine & vbNewLine & "If all is good, click on Yes to Continue or click on No to Exit."
Ans = MsgBox(MsgTxt, vbQuestion + vbYesNo, "Confirm Please!")

If Ans = vbNo Then Exit Sub

For i = 2 To lRw
    ErrorsFound = False
    SourceFolder = oWS.Range("A" & i).Value
    SourceFile = oWS.Range("B" & i).Value
    TargetFile = oWS.Range("C" & i).Value
    
    'Check if folder end with \. If not create it
    If Right(SourceFolder, 1) <> Application.PathSeparator Then SourceFolder = SourceFolder & Application.PathSeparator
    
    'Check if folder exist
    If Not fso.FolderExists(SourceFolder) Then
        oWS.Cells(i, 4).Value = "From folder does not exist."
        oWS.Cells(i, 4).Font.Color = vbRed
        ErrorsFound = True
    End If
    
    'Check if source files exist
    If Not fso.FileExists(SourceFolder & SourceFile) Then
        oWS.Cells(i, 4).Value = "From file does not exist."
        oWS.Cells(i, 4).Font.Color = vbRed
        ErrorsFound = True
    End If
    
    'Check if target files exist
    If fso.FileExists(SourceFolder & TargetFile) Then
        oWS.Cells(i, 4).Value = "To file already exists."
        oWS.Cells(i, 4).Font.Color = vbRed
        ErrorsFound = True
    End If
    
    If Not ErrorsFound Then
        Name SourceFolder & SourceFile As SourceFolder & TargetFile
        oWS.Cells(i, 4).Value = "File renamed."
        oWS.Cells(i, 4).Font.Color = vbGreen
    End If
Next i

If ErrorsFound Then
    MsgBox ("ERRORS OCCURED, check detail status on each line.")
Else
    MsgBox ("Files have been processed with no errors.")
End If

Exit Sub
Error_Routine:
MsgBox Err.Description, vbExclamation, "Something went wrong!" & _
vbNewLine & " Unable to proceed, please check the consistency of data reported (ie: file name with extension) or if file to rename is opened."

End Sub

Open in new window


Given that I have 5 modules and more than 100 procedures in my add-in file I don't know what is the best approach in terms of variable declaration/option explicit. The top would be to rationalise variables however this is complicated as I need to check procedure by procedure. Let me know if you see another approach.

Thank you for your help.
Fabrice LambertConsulting
CERTIFIED EXPERT
Distinguished Expert 2017

Commented:

Option explicit must be mandatory in all modules, period.


As for variable déclarations, unless you have a very valid reason, avoid global ones at all cost!! For the simple Reason that as your project grow, you'll loose control on wich function update wich variable, thus making bugs tracking a painfull task.
Function parameters exist for a reason, use them.