《批量修改文件名，网上的方法试过了，都失败，无奈求救》

434814200

有510张图片，想要用excel批量重命名（名字有空格），搜了网上的教程，用ren命令一直执行不成功，研究了很久没能结果。

想用vba解决，论坛看了好多帖子，没找到我想要的答案，只能求助，谢谢大神指点啦。

lilyhcn1

这玩意去找找批量重命名工具好了，搜索关键词
春林重命名

考试加油站

先批量获取原文件名，再改名，你的原始表中路径也不完整，我给你模拟了一下。

1. Public jg(), khm&, tms#                               '
   
2. Private Fso As Object, myPath As String
   
3. Sub 选择要批量重命名文件的文件夹()
   
4.     Dim Fo, SHT As Worksheet
   
5.     Sheets("修改文件名").Activate
   
6.     Sheets("修改文件名").Range("A1").Value = "原始路径"
   
7.     Sheets("修改文件名").Range("b1").Value = "原文件名"
   
8.     Sheets("修改文件名").Range("c1").Value = "新文件名"
   
9.     With Application.FileDialog(msoFileDialogFolderPicker)
   
10.         .Title = "请选择要提取与导入或重命名的图片或文件所在的文件夹"
    
11.         .Show
    
12.         If .SelectedItems.Count = 0 Then Exit Sub
    
13.         myPath = .SelectedItems(1) & ""
    
14.     End With
    
15.     Set Fso = CreateObject("Scripting.FileSystemObject")
    
16.     Set Fo = Fso.getfolder(myPath)
    
17.     Call 递归(Fo)
    
18. 
    
19. End Sub
    
20. Sub 获取文件名(Folder)
    
21.     Dim Fi, filename As String, r As Integer
    
22.     For Each Fi In Folder.Files
    
23.         r = Range("A65536").End(xlUp).Row + 1
    
24.         filename = Fi.Name
    
25.         Cells(r, 1) = Folder.path & ""
    
26.         Cells(r, 2) = Fso.getbasename(filename)
    
27.         Cells(r, 4) = "." & Fso.GetExtensionName(filename)
    
28.         r = r + 1
    
29.     Next
    
30. End Sub
    
31. 
    
32. Sub 递归(Folder)
    
33.     Dim Fi, Fo
    
34.     Call 获取文件名(Folder)
    
35.     If Folder.subfolders.Count > 0 Then
    
36.         For Each Fo In Folder.subfolders
    
37.             Call 递归(Fo)
    
38.         Next
    
39.     End If
    
40. End Sub
    
41. Sub 文件批量重命名()
    
42.     On Error Resume Next
    
43.     Dim i As Integer, r As Integer, rng As Range
    
44.     r = Range("A65536").End(xlUp).Row
    
45.     For Each rng In Range("C2:C" & r)
    
46.         If rng = "" Then MsgBox "请将新文件名填写完整!", 64, "提示": Exit Sub
    
47.     Next
    
48.     For i = 2 To Range("A65536").End(xlUp).Row
    
49.         Name Cells(i, 1) & Cells(i, 2) & Cells(i, 4) As Cells(i, 1) & Cells(i, 3) & Cells(i, 4)
    
50.     Next
    
51.     MsgBox "文件名修改完成，请到文件所在文件夹查看!", 64, "提示"
    
52. End Sub
    
53. 
    
54. <b>
    
55. </b>

复制代码

新建文件夹 (2).rar (59.81 KB, 下载次数: 38)

2020-11-14 17:04 上传

点击文件名下载附件

434814200

考试加油站 发表于 2020-11-14 17:04
先批量获取原文件名，再改名，你的原始表中路径也不完整，我给你模拟了一下。

你好，附件是破坏的，打不开，能重新发一遍吗？谢谢了

434814200

lilyhcn1 发表于 2020-11-14 16:50
这玩意去找找批量重命名工具好了，搜索关键词
春林重命名

找了好几个抖不适合，你说的春林也不行，源文件导入后，没有按照顺序排列不能智能对应名字

考试加油站

434814200 发表于 2020-11-14 19:50
你好，附件是破坏的，打不开，能重新发一遍吗？谢谢了

我测试附件正常，你可以下载新版的解压软件打开

lilyhcn1

434814200 发表于 2020-11-14 20:04
找了好几个抖不适合，你说的春林也不行，源文件导入后，没有按照顺序排列不能智能对应名字

文件名中不能有"："啊，去掉就正常了。

434814200

考试加油站 发表于 2020-11-14 20:12
我测试附件正常，你可以下载新版的解压软件打开

好的，谢谢咯

kimhaori

考试加油站 发表于 2020-11-14 17:04
先批量获取原文件名，再改名，你的原始表中路径也不完整，我给你模拟了一下。

太厉害了，这就是我苦苦寻找的