Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 4570|回复: 14

[已解决]利用VBA批量重置指定格式文件名

  [复制链接]
发表于 2011-9-9 18:28 | 显示全部楼层 |阅读模式

   电脑E盘某个文件夹下,有几千张.PNG图片,命名不规则,不方便管理及查阅。
   请教一下,可否利用VBA进行按规则重命名。

   比如有10000张,从第1张开始,命名为:A00001、A00002、......A10000

   不知道可否操作?敬请指点!

   如果能在打开文件夹时,选择文件格式,最好了。{:161:}
最佳答案
2011-9-9 21:54
给你一个批量修改文件名的文件:
批量修改文件名.rar (19.12 KB, 下载次数: 50)
发表于 2011-9-9 20:30 | 显示全部楼层
回复 opelwang 的帖子

ACDES 软件就有批量重量命名功能!还可以批量转换格式,批量调整图片大小!!这些都比VBA方便 !!
回复

使用道具 举报

发表于 2011-9-9 21:07 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2011-9-9 21:10 | 显示全部楼层
liuguansky 发表于 2011-9-9 21:07
name
就可以重命名了。



期待:叶版 的大作。{:161:}
回复

使用道具 举报

发表于 2011-9-9 21:54 | 显示全部楼层    本楼为最佳答案   
给你一个批量修改文件名的文件:
批量修改文件名.rar (19.12 KB, 下载次数: 50)
回复

使用道具 举报

 楼主| 发表于 2011-9-9 22:01 | 显示全部楼层
感谢:zjdh 仁兄指点,效果不错,值得学习。
回复

使用道具 举报

发表于 2011-9-9 22:24 | 显示全部楼层
本帖最后由 zjdh 于 2011-9-11 09:23 编辑

再给你一个自动批量修改文件名的宏,可以自由选择文件格式(扩展名):
  1. Sub 批量更名()
  2.     Dim TH As Object, Directory$
  3.     Dim OB As Object
  4.     Dim DT, FL
  5.     On Error Resume Next
  6.     N = InputBox("请输入文件扩展名", "选择", "PNG")
  7.     If N = "" Then Exit Sub
  8.     N = UCase(N)
  9.     Set TH = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件目录:", &H1)
  10.     If Not TH Is Nothing Then
  11.         Directory = TH.self.Path
  12.         If Not Directory Like "*" Then Directory = Directory & ""
  13.     End If
  14.     Set OB = CreateObject("Scripting.FileSystemObject")
  15.     Set DT = OB.GetFolder(Directory)
  16.     For Each FL In DT.Files
  17.         If UCase(Split(FL.Name, ".")(1)) = N Then
  18.             M = M + 1
  19.             FL.Name = "A" & Format(M, "00000") & "." & N
  20.         End If
  21.     Next
  22.     If M = "" Then MsgBox "【 " & Directory & " 】目录中没有" & N & "文件"
  23.     MsgBox "文件已更名,请检查"
  24. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
opelwang + 3 测试了,好用。

查看全部评分

回复

使用道具 举报

发表于 2011-9-9 22:28 | 显示全部楼层
更名为A00001~A00002~......
回复

使用道具 举报

 楼主| 发表于 2011-9-9 22:32 | 显示全部楼层
zjdh 发表于 2011-9-9 22:24
再给你一个自动批量修改文件名的宏,可以自由选择文件格式(扩展名):

7楼的代码效果不错。

提两个建议:
1、前缀字母:A,改成弹窗输入,如:B,C,D或其它字符。这样的话可以自定义前缀。
2、在运行结束后加个弹窗提示:共修改了?个文件,用时?秒。
    时间保留整数即可。


期待帮忙完善,谢谢。
回复

使用道具 举报

发表于 2011-9-10 07:58 | 显示全部楼层
本帖最后由 zjdh 于 2011-9-11 09:23 编辑

这个不难:
  1. Sub 批量更名()
  2.     Dim TH As Object, Directory$
  3.     Dim OB As Object
  4.     Dim DT, FL, A$, T, M&
  5.     On Error Resume Next
  6.     T = Timer
  7.     N = InputBox("请输入文件扩展名", "选择", "PNG")
  8.     If N = "" Then Exit Sub
  9.     N = UCase(N)
  10.     A = InputBox("请输入更名前缀", "选择", "A")
  11.     If A = "" Then Exit Sub
  12.     A = UCase(A)
  13.     Set TH = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件目录:", &H1)
  14.     If Not TH Is Nothing Then
  15.         Directory = TH.self.Path
  16.         If Not Directory Like "*" Then Directory = Directory & ""
  17.     End If
  18.     Set OB = CreateObject("Scripting.FileSystemObject")
  19.     Set DT = OB.GetFolder(Directory)
  20.     For Each FL In DT.Files
  21.         If UCase(Split(FL.Name, ".")(1)) = N Then
  22.             M = M + 1
  23.             FL.Name = A & Format(M, "00000") & "." & N
  24.         End If
  25.     Next
  26.     If M = "" Then MsgBox "【 " & Directory & " 】目录中没有" & N & "文件"
  27.     MsgBox "共有" & M & "个文件已更名,请检查!" & Chr(13) & "共用时" & Format(Timer - T, "0.00") & " 秒!!"
  28. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
opelwang + 3 非常感谢。

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 22:39 , Processed in 1.000237 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表