如何修改VBA代码批量重命名指定文件夹内WEEKLY格式文件

关于原代码的疑问 #

你猜的没错，原代码确实需要把旧文件名手动填入A列、新文件名填入B列才能执行重命名——它本质是基于Excel表格的映射来批量改名，完全不符合你自动识别格式并重命名的需求，所以得彻底修改核心逻辑。

修改后的VBA代码 #

下面是适配你需求的代码，不需要依赖Excel表格，自动识别符合格式的文件并完成重命名：

Sub RenameWeeklyFiles()
    Dim xDir As String
    Dim xFile As String
    Dim newFileName As String
    Dim fileExt As String
    
    ' 让用户选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub ' 用户取消选择则退出
        xDir = .SelectedItems(1) & Application.PathSeparator
    End With
    
    ' 遍历文件夹内所有文件
    xFile = Dir(xDir & "*")
    Do Until xFile = ""
        ' 检查文件名是否符合"WEEKLY 00.00.00"格式（兼容带扩展名的情况）
        If xFile Like "WEEKLY ##.##.##*" Then
            ' 分离文件名和扩展名
            fileExt = Mid(xFile, InStrRev(xFile, ".")) ' 获取文件扩展名（比如.txt）
            ' 提取日期字符串：从"WEEKLY "之后到扩展名之前的部分
            newFileName = Mid(xFile, 8, InStrRev(xFile, ".") - 8)
            ' 把日期里的点替换成下划线，再拼接扩展名
            newFileName = Replace(newFileName, ".", "_") & fileExt
            
            ' 执行重命名，加入错误处理避免崩溃
            On Error Resume Next
            Name xDir & xFile As xDir & newFileName
            If Err.Number <> 0 Then
                MsgBox "文件重命名失败：" & xFile & vbCrLf & "错误原因：" & Err.Description
            End If
            On Error GoTo 0
        End If
        xFile = Dir ' 切换到下一个文件
    Loop
    
    MsgBox "重命名操作完成！"
End Sub

代码关键说明 #

• 保留了原代码的文件夹选择功能，操作灵活
• 用Like "WEEKLY ##.##.##*"自动匹配符合格式的文件名，##代表任意数字
• 自动提取日期部分，替换点为下划线，同时完整保留原文件的扩展名
• 加入错误处理，遇到重名、权限不足等问题会弹出提示，避免程序直接崩溃
• 全程不需要手动维护Excel表格，自动识别处理目标文件

内容的提问来源于stack exchange，提问作者Mecca Miles