分享自用的EXCEL版文件重命名工具 视频讲解 开源

百度不到去谷歌

批量文件重命名,相信很多人在工作中会遇到这种情况,批量修改前缀,去除某些字符,添加局部描述,增加修改编号等等,网上也有很多重命名工具,我也用过好些个,实在是不顺手,俗话说得好,自己动手,丰衣足食,于是我自己写了一个EXCEL版的文件重命名,文件名导入到excel里,结合excel的排序和函数处理,批量重命名就变得非常自由和轻松了,文件下载方式请看视频

使用方法 视频讲解地址
http://excel880.com/blog/archives/2187
附件 解压密码为 excel880.com
   最好用的批量文件改名工具-EXCEL版文件重命名工具使用详解 .rar (437.98 KB, 下载次数: 501)

2017-6-11 19:21 上传

点击文件名下载附件

laoau128

好东东，第一个顶你了

jjmysjg

留个记号。先看看

塔奇克马

excel+vba简直了
和一般的程序设计相比，中间省去了（或者说excel+vba代工）很多工作。
不过嘛，宿主excel肯定是跑不了的
这就是vba的魅力啊

lzqlaj

谢谢分享。不过有插播广告的嫌疑，关闭工作簿时，打开http:\\excel880.xyz。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Shell "explorer http:\\excel880.xyz"
End Sub

lzqlaj

到楼主的网页看了看，最后到淘宝网站了。

liucqa

1. 
   
2. Public Sub PickFolder()
   
3. '** 使用FileDialog对象来选择文件夹
   
4.         Dim fd As FileDialog
   
5.         Dim strPath As String
   
6.       
   
7.         Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
8.       
   
9.         '** 显示选择文件夹对话框
   
10.         If fd.Show = -1 Then        '** 用户选择了文件夹
    
11.             strPath = fd.SelectedItems(1)
    
12.         Else
    
13.             strPath = ""
    
14.         End If
    
15.         [B1] = strPath
    
16.         Set fd = Nothing
    
17. End Sub
    
18. Sub ReName()
    
19.     Dim arr, e
    
20.     On Error Resume Next
    
21.     For i = 4 To [A65536].End(xlUp).Row
    
22.         If Cells(i, 3) <> "" Then
    
23.             Name [B1] & "" & Cells(i, 1) & Cells(i, 2) As [B1] & "" & Cells(i, 3) & Cells(i, 2)
    
24.         End If
    
25.         
    
26.     Next
    
27.     MsgBox "重命名成功!"
    
28. End Sub
    
29. Sub 获取目录()
    
30.     Dim fs, f, f1, s, sf
    
31.     Dim r As Range
    
32.     Set fs = CreateObject("Scripting.FileSystemObject")
    
33.     Set f = fs.GetFolder([B1])
    
34.     Set sf = f.Files
    
35.     [A4:A65536] = ""
    
36.     For Each f1 In sf
    
37.         s = f1.Name
    
38.         Set r = [A65536].End(xlUp).Offset(1)
    
39.         n = InStrRev(s, ".")
    
40.         r = Left(s, n - 1) '文件名
    
41.         r.Offset(0, 1) = Mid(s, n)  '后缀
    
42.     Next
    
43.    
    
44. End Sub
    

复制代码

代码有点糙啊，你不是只为了打广告吧。

这标题和这代码不是一个等级，哈哈哈哈哈哈哈哈

百度不到去谷歌

liucqa 发表于 2017-6-12 11:30
代码有点糙啊，你不是只为了打广告吧。

这标题和这代码不是一个等级，哈哈哈哈哈哈哈哈

标题并没有夸大吧  我自己用的 代码是比较糙 重要的是功能好用  

百度不到去谷歌

lzqlaj 发表于 2017-6-12 09:25
到楼主的网页看了看，最后到淘宝网站了。

眼里有干货的自然能找到干货  你只找到淘宝 那我也没办法

APPLE123

谢谢！先试试看