关于使用VBA批量修改文件夹下子文件下excel文件名

zx6091024

Sub RenameExcelFilesInSubfolders()
    Dim targetPath As String
    Dim oldName1 As String
    Dim newName1 As String
    Dim oldName2 As String
    Dim newName2 As String
    Dim folder As Object
    Dim subFile As Object
    Dim fso As Object
    Dim subFolder As Object

    ' 设置目标文件夹路径
    targetPath = "D:\文件\回收率1" ' 请修改成实际路径
    oldName1 = ThisWorkbook.Sheets("回收明细").Range("H2").Value ' 从 H2 获取要查找的文件名
    newName1 = ThisWorkbook.Sheets("回收明细").Range("I2").Value ' 从 I2 获取新的文件名
    oldName2 = ThisWorkbook.Sheets("回收明细").Range("H3").Value ' 从 H3 获取要查找的文件名
    newName2 = ThisWorkbook.Sheets("回收明细").Range("I3").Value ' 从 I3 获取新的文件名

    Set fso = CreateObject("Scripting.FileSystemObject")

    ' 遍历目标文件夹下的所有子文件夹
    For Each subFolder In fso.GetFolder(targetPath).SubFolders
        ' 遍历子文件夹中的所有文件
        For Each subFile In subFolder.Files
            ' 检查文件扩展名是否为Excel文件（.xls, .xlsx, .xlsm等）
                ' 判断文件名是否匹配
                If subFile.Name = oldName1 Then
                    subFile.Name = newName1
                ElseIf subFile.Name = oldName2 Then
                    subFile.Name = newName2
                End If
        Next subFile
    Next subFolder
    MsgBox "操作完成！", vbInformation
End Sub


写是这么写的，最终运行结果只有H3变成了I3,H2重命名为I2失败了。

ynzsvt

应该是扩展名有大小写的，建议全转化为小写后比较。

liulang0808

使用name as修改文件名是否可行的

过客fppt

这是一个示例

过客fppt

过客fppt 发表于 2024-8-16 14:04
这是一个示例

1.         
   
2. Sub 批量修改文件夹内Word文档名称()
   
3.    
   
4.     Dim folderPath As String
   
5.     Dim file As String
   
6.     Dim name As String
   
7.     Dim dialog As FileDialog
   
8.     Dim n, i
   
9.    
   
10.     Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
    
11.    
    
12.     ' 打开文件夹选择对话框
    
13.     With dialog
    
14.         .Title = "选择文件夹"
    
15.         .AllowMultiSelect = False
    
16.         If .Show <> -1 Then
    
17.             MsgBox "未选择文件夹！"
    
18.             Exit Sub
    
19.         Else
    
20.             folderPath = .SelectedItems(1)
    
21.         End If
    
22.     End With
    
23.    
    
24.     i = 0
    
25.     ' 遍历文件夹中的所有文件
    
26.     file = Dir(folderPath & "\*.*")
    
27.     Do While file <> ""
    
28.         ' 如果是Word文件，则进行重命名
    
29.         If InStr(1, LCase(file), ".doc") > 0 Or InStr(1, LCase(file), ".docx") > 0 Then
    
30. 
    
31.             name = file
    
32.             name = Replace(name, "模板", "模板二号")
    
33.             Name folderPath & "" & file As folderPath & "" & name
    
34.             i = i + 1
    
35.         End If
    
36.         file = Dir
    
37.     Loop
    
38.    
    
39.     MsgBox i & "个文件重命名完成！"
    
40. End Sub

复制代码

zx6091024

ynzsvt 发表于 2024-8-16 12:25
应该是扩展名有大小写的，建议全转化为小写后比较。

看过了，拓展名全都是小写的。

zx6091024

过客fppt 发表于 2024-8-16 14:04
这是一个示例

好的，谢谢 ，我试一下。

ynzsvt

zx6091024 发表于 2024-8-16 21:37
看过了，拓展名全都是小写的。

那就要打包这两个文件了。