|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
在日常生活中，我们经常需要整理相片以及一些扫描的相片文件，扫描仪器以及数码相机导出来的文件名称，往往是带着长长字符串的文件名。一个个的对每一个文件进行重命名的动作固然能解决问题。但是如果该文件夹里的文档数量相当庞大，--一一转换起来就显得太麻烦了。今天要帮助大家提高工作效率，又快又好地用EXCEL批量迅速修改某个文件夹里的文件名字，而且能随心所欲的运用EXCEL对文件名进行拖拽。
创建模块
打开EXCEL2003，右击第一张工作表标签选择“查看代码”，之后右击工程VBA PROJECT->插入->模块，或 “工具”->”宏”->”VISUAL BASIC编辑器”
添加VBA代码
选择新插入的模块后，插入以下代码后保存退出。
Dim filePath As Variant '定义filepath为变量
Dim obj As Object '定义obj为变量对象
Dim fld, ff, gg '定义fld,ff,gg为变量
Sub getpath()
Range("A2:C1000").ClearContents '清空A2：C1000列
On Error Resume Next
Dim shell As Variant
Set shell = CreateObject("Shell.Application")
Set filePath = shell.BrowseForFolder(&O0, "选择文件夹", &H1 + &H10, "") '获取文件夹路径地址
Set shell = Nothing
If filePath Is Nothing Then '检测是否获得有效路径，如取消直接跳出程序
Exit Sub
Else
gg = filePath.Items.Item.path
End If
Set obj = CreateObject("Scripting.FileSystemObject") '定义变量
Set fld = obj.getfolder(gg) '获取路径
For Each ff In fld.Files '遍历文件夹里文件
m = m + 1
Cells(m + 1, 1) = ff.Name
Cells(m + 1, 2) = "-------"
Cells(m + 1, 3) = ff.Name
Next
End Sub
Sub renamefile()
On Error Resume Next
If [a2] = "" Then MsgBox "请点击第一步": Exit Sub
For Each ff In fld.Files '遍历文件夹里的所有文件
m = m + 1
ff.Name = Cells(m + 1, 3) '将实际文件名改成目录中C列的对应文件名
Next
MsgBox "改名已完成，请检查", vbOKOnly
End Sub
创建两个按钮，
按钮一名称改为“第一步，获得原文件名”，按钮二名称改为”第二步，改成新文件名”
将按钮一“第一步，获得原文件名”指向宏getpath
按钮二”第二步，改成新文件名”指向宏renamefile
当然也可以直接点击“工具”->”宏->运行”宏”，然后选择相关的宏getpath和renamefile。
这样，整个批量修改文件名的EXCEL表格也就创建出来了。
具体操作
以后凡遇到需要批量修改文件名的时候，只需要打开该EXCEL文件，按一下第一步按钮一获取文件路径，EXCEL将会弹出一个对话框（“选择文件夹”）向导。
选择需要修改的文件夹之后，
EXCEL里就会罗列出该文件夹里的所有文件名于A列和对应的C列上。将所希望修改的文件名字对应填在C列即可。例如：在C2上填个1.扩展名，然后CTRL+拖拽到C101，这样就可以得到有序的1到100的文件名。
确认之后按一下按钮，则成功将该文件夹里的文件名真正修改成了EXCEL里的C列的名。之后会出现一句提示："改名已完成，请检查"
确认后就可以去检查目标文件夹里文件名的修改情况。
对需要大量处理文档以及相片的工作者相当实用。
注：由于该目录是需要通过宏功能起作用的，所以当打开工作簿时，EXCEL2007默认会禁用宏，得单击警告栏中的“选项”按钮，选中“启用此内容”单选项,确定后才能运行宏更新目录。EXCEL2003则在“工具”->“宏”->“安全性”中设置为“中”或“低”即可 |
评分
-
5
查看全部评分
-
|
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2011-1-23 11:14
楼主
发表于 2011-1-23 21:03
