不确定“所有文件都被命名为粗略”是什么意思，所以为了灵活起见，请考虑使用正则表达式。

Option Explicit

Sub RenameFiles()

    Dim xDir As String, xFile As String
    Dim n As Long, sNew As String
    
    Dim regex, m
    Set regex = CreateObject("vbscript.regexp")
    With regex
        .Global = True
        .MultiLine = False
        .IgnoreCase = True
        ' capture groups () $1 $2 $3 $4 $5
        .Pattern = "(.*)(?:WEEKLY (\d\d)\.(\d\d)\.(\d\d))(.*)"
    End With

    ' select folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            xDir = .SelectedItems(1)
        End If
    End With
    If xDir = "" Then Exit Sub
            
    ' scan files
    xDir = xDir & Application.PathSeparator
    xFile = Dir(xDir & "*")
    Do Until xFile = ""
        ' select pattern matching files
        If regex.test(xFile) Then
            ' modify name
            sNew = regex.Replace(xFile, "$1$2_$3_$4$5")
            Name xDir & xFile As xDir & sNew
            
            Debug.Print xFile, sNew
            n = n + 1
        End If
        xFile = Dir ' next file
        
    Loop
    MsgBox n & " files renamed", vbInformation, xDir
        
End Sub

如果您希望返回一些文件名、更改它们、构建文件夹...或您想在文件系统中做的任何其他事情，使用FileSystemObject对新用户来说确实很有帮助。
下面的代码只会将文件名从“00.00.00”更改为“00_00_00”：

Option Explicit
Sub RenameFiles()
    
    Dim xDir As String      'Directory
    Dim oFSO As Object      'File System Object
    Dim oFolder As Object   'FSO Folder
    Dim oFile As Object     'FSO File
    Dim ExtType As String   'Extension Type
    Dim NewDir As String    'New File Directory
    Dim NewName As String   'New File Name
    
    ' Do not include period -> Good:="xlsx" ; Bad:=".xlsx"
    ExtType = "xlsx"
    
    Set oFSO = CreateObject("scripting.filesystemobject")
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        xDir = .SelectedItems(1)
    End With
    
    Set oFolder = oFSO.getfolder(xDir)
    
    ' > This is how to print the names on each of the files in the folder.
    For Each oFile In oFolder.Files
        Debug.Print oFile.Name
    Next oFile
    
    ' > This is an example of how to rename files.
    '   You can make as many changes to the file name as you want befor
    '   sticking it all back together and renaming.
    '   This example only replaces "." with "_"
    For Each oFile In oFolder.Files
        ' > Check if file is a specified file type.
        If oFSO.getextensionname(oFile.Path) = ExtType Then
            ' > Build New Directory:
            NewName = Left(oFile.Name, Len(oFile.Name) - Len(ExtType) - 1)
            NewName = Replace(NewName, ".", "_")
            NewDir = xDir & "\" & NewName & "." & ExtType
            Debug.Print NewDir
            ' > Rename File
            '   |_Rename_|_old_path_|_new_path_|
            oFSO.movefile oFile.Path, NewDir
        End If
    Next oFile
    

End Sub

**EDIT**

如果要删除除日期以外的所有内容：

Option Explicit
Sub RenameFiles()
    
    Dim xDir As String      'Directory
    Dim oFSO As Object      'File System Object
    Dim oFolder As Object   'FSO Folder
    Dim oFile As Object     'FSO File
    Dim ExtType As String   'Extension Type
    Dim NewDir As String    'New File Directory
    Dim NewName As String   'New File Name
    
    ' Do not include period -> Good:="xlsx" ; Bad:=".xlsx"
    ExtType = "xlsx"
    
    Set oFSO = CreateObject("scripting.filesystemobject")
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        xDir = .SelectedItems(1)
    End With
    
    Set oFolder = oFSO.getfolder(xDir)
    
    ' > This is an example of how to rename files.
    '   You can make as many changes to the file name as you want befor
    '   sticking it all back together and renaming.
    '   This example only replaces "." with "_"
    For Each oFile In oFolder.Files
        ' > Check if file is a specified file type.
        If oFSO.getextensionname(oFile.Path) = ExtType Then
            ' > Build New Directory:
            NewName = Left(oFile.Name, Len(oFile.Name) - Len(ExtType) - 1)
            NewName = CleanStringOnlyDate(NewName)
            NewName = Replace(NewName, ".", "_")
            NewDir = xDir & "\" & NewName & "." & ExtType
            Debug.Print NewDir
            ' > Rename File
            '   |_Rename_|_old_path_|_new_path_|
            oFSO.movefile oFile.Path, NewDir
        End If
    Next oFile
    
End Sub
Function CleanStringOnlyDate(Str As String) As String
    Dim I As Long
    For I = 1 To Len(Str) - 7
        If Mid(Str, I, 8) Like "##*##*##" Then
            CleanStringOnlyDate = Mid(Str, I, 8)
            Exit Function
        End If
    Next I
End Function

发件人：

收件人：

要添加单词：

...
            NewName = CleanStringOnlyDate(NewName)
            NewName = "ExampleFile" & Replace(NewName, ".", "_")
            NewDir = xDir & "\" & NewName & "." & ExtType
...