asked on

Excel VBA: add string on files

Hello experts,
I have the following procedure which allows me to add date-stamp on files located in a folder:

Sub Add_Date_Stamp_On_Files()
' Local variables
    Dim BaseFolder As String, NextFile As String, TimeStamp As String, FileExt As String
    Dim i As Integer
    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
    TimeStamp = Format(Now, "YYYYMMDD_HHMMSS")

    ' 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 & "_" & TimeStamp & FileExt

        ' Go to next file
        NextFile = Dir

    Loop

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

End Sub

Open in new window

I would like to take it as a reference and add the following requirement:
-Instead of adding datestamp I would like to have inputbox with the following information: "Enter the string that you want to add at the end of your files."

If you have questions, please contact me.
Thank you for your help.

Subodh Tiwari (Neeraj)

Hi Luis,

Please give this a try...

Sub Add_Date_Stamp_On_Files()
' Local variables
    Dim BaseFolder As String, NextFile As String, FileExt As String
    Dim i As Integer
    Dim StrToAdd As String
    
    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 stamped successfully.", vbInformation, "Files renamed!"
    Shell "C:\WINDOWS\explorer.exe """ & BaseFolder & "", vbNormalFocus
Exit Sub
Error_Routine:
MsgBox Err.Description, vbExclamation, "Something went wrong!"

End Sub

Open in new window

Luis Diaz

ASKER

Hi Subodh
I tested and it works!
Could you please help me to add the the following preliminary message:

    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 are located files to rename"

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

Open in new window

Thank you in advance for your help.

ASKER CERTIFIED SOLUTION

Subodh Tiwari (Neeraj)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

SOLUTION

Subodh Tiwari (Neeraj)

membership

This solution is only available to members.