Is this what you are wanting? Inputbox will prompt for which type of files that you want to work with. Also will create a list of the files that have changed if user selects yes after code is run.
Option Explicit
Const App_Name As String = "Rename files WiseMan v_1.0.0"
Sub RenameFiles()
Dim FSO As Object
Dim FLD As Object
Dim fil As Variant
Dim sPath As String
Dim sOldName As String
Dim sNewName As String
Dim sTempFile() As String
Dim sFileExtention As String
Dim sChangedFiles() As Variant
Dim i As Long
'Use Inputbox to get what files to work with
sFileExtention = Application.InputBox(Prompt:="Enter the file extension to change the names of the files." & vbCrLf & _
"Examples of file extensions: xls, xlsx, xlsm, txt, docx", Title:=App_Name, Default:="xlsx", Type:=2)
ReDim sChangedFiles(0)
sChangedFiles(UBound(sChangedFiles)) = Array("From", "To")
'Define the path to the files
sPath = ThisWorkbook.Path
'Create the instance of the FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
'Set the folder you want to search. NOTE - some antivirus may not like this
Set FLD = FSO.GetFolder(sPath)
'Loop through each file in the folder
For Each fil In FLD.Files
'Get complete file name with path
sOldName = fil.Path
'Change to file type you want
If FSO.GetExtensionName(sOldName) = LCase(Trim$(sFileExtention)) Then
'Check the file has an underscore in the name
If InStr(sOldName, "_") > 0 Then
'Split the file on the underscore so we can get everything before it
sTempFile = Split(sOldName, "_")
'Create an array of file names that have changed
ReDim Preserve sChangedFiles(UBound(sChangedFiles) + 1)
sChangedFiles(UBound(sChangedFiles)) = Array(fil.Name, sTempFile(UBound(sTempFile)))
'Build the new file name with everything before the
'first under score plus the extension
sNewName = sPath & "\" & sTempFile(UBound(sTempFile))
'Use the MoveFile method to rename the file
FSO.MoveFile sOldName, sNewName
End If
End If
Next
'Cleanup the objects
Set FLD = Nothing
Set FSO = Nothing
'Exit sub if no files found
If UBound(sChangedFiles) = 0 Then Exit Sub
'Ask if user would like a list of files that have changed
'Output the files names that have changed. From file name To file name
If MsgBox(Prompt:="Would you like to create a list of files names that have changed?", Buttons:=vbQuestion + vbYesNoCancel, Title:=App_Name) = vbYes Then
Worksheets.Add
For i = 0 To UBound(sChangedFiles)
Cells(i + 1, 1).Resize(, 2) = sChangedFiles(i)
Next
Cells.EntireColumn.AutoFit
End If
End Sub