Standing on the shoulders of the code already provided by
Peterson here
https://www.msofficeforums.com/163214-post3.html
Code:
Sub RenameFile()
' Before running the code, click Tools > References in the Visual Basic Editor and
' make sure that "Microsoft Scripting Runtime" is checked.
Dim strPath As String, objFile As File, sName As String, sNewName As String, sNewPath As String
Dim objFolder As Folder, objFSO As Scripting.FileSystemObject
' Put your path here:
strPath = "C:\Users\username\MyFiles\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strPath) Then
Set objFolder = objFSO.GetFolder(strPath)
For Each objFile In objFSO.GetFolder(strPath).Files 'Loop through all files in the folder
sName = objFile.Name
If Len(sName) > 16 And IsNumeric(Left(sName, 5)) Then 'If file starts with 5 digits and has a name longer that 16 characters
sNewName = Trim(Mid(sName, 16))
objFSO.CopyFile strPath & objFile.Name, strPath & sNewName, True
objFSO.DeleteFile (objFile.Path) ' Delete the original file
End If
Next objFile
End If
End Sub