Excel VBA: add string at the beginning and at the end for files and folders

Sub Add_String_On_Files()
' Local variables
    Dim BaseFolder As String, NextFile As String, FileExt As String
    Dim I As Integer
    Dim StrToAdd As String
    Dim MsgTxt As String
    
    MsgTxt = "Before running this procedure, make sure to report following information in range A1:"
    MsgTxt = MsgTxt & vbNewLine & " 1-Path directory in which you want are located files to rename"

    Ans = MsgBox(MsgTxt & vbNewLine & vbNewLine & _
                "Do you want to continue?", vbQuestion + vbYesNo, "Confirm Please!")
    If Ans = vbNo Then Exit Sub
    
    On Error GoTo Error_Routine
    ' Stop if no base folder provided
    If ActiveSheet.Range("A1").Value = "" Then
        MsgBox "A1 doesn't contain a directory string.", vbExclamation
        Exit Sub
    End If

    ' Stop if base folder provided does not exist
    BaseFolder = ActiveSheet.Range("A1").Value
    If Right(BaseFolder, 1) <> Application.PathSeparator Then BaseFolder = BaseFolder & Application.PathSeparator

    If Len(Dir(BaseFolder, vbDirectory)) = 0 Then
        MsgBox "Directory in A1 does not exist.", vbExclamation
        Exit Sub
    End If

    ' Get current date time
        
    StrToAdd = InputBox("Enter the string that you want to add at the end of your files.")
    
    If StrToAdd = "" Then
        MsgBox "You didn't enter any string to add at the end of the files.", vbExclamation
        Exit Sub
    End If
    
    ' Process each file in the base folder
    NextFile = Dir(BaseFolder & "\*.*")
    Do While Len(NextFile) > 0

        ' Separate file name from extension
        sFil = NextFile
        FileExt = ""
        I = InStrRev(NextFile, ".")
        If I > 0 Then
            FileExt = Right(sFil, Len(sFil) - I + 1)
            sFil = Mid(sFil, 1, I - 1)
        End If

        ' Rename file adding time stamp
        Name BaseFolder & NextFile As BaseFolder & sFil & "_" & StrToAdd & FileExt

        ' Go to next file
        NextFile = Dir

    Loop

    MsgBox "Files reported: " & BaseFolder & " have been renamed successfully.", vbInformation, "Files renamed!"
    Shell "C:\WINDOWS\explorer.exe """ & BaseFolder & "", vbNormalFocus
Exit Sub
Error_Routine:
MsgBox Err.Description, vbExclamation, "Something went wrong!"

End Sub

Select allOpen in new window