【VBA】使用vba进行文件批量重命名(自定义后缀,重复文件自动编号)

        笔者在一段工作经历中有批量管理附件的需要,因此使用了vba进行文件名的重命名和管理。vba命名时文件名可以是汉字,字母,数字,全半角符号等,具有很强的包容性;而使用dos编码的bat文件则只能重命名字母、数字和符号,无法对汉字重命名。

        然而经常会遇到要命名的文件名已存在,或者多个文件名需要命名成同一个名字,需要后面用括号数字区分的情况,可以参考以下解决办法。

先说我的excel单元格设置:【VBA】使用vba进行文件批量重命名(自定义后缀,重复文件自动编号)_第1张图片

         L9用来存放文件地址,E4和G4存放文件格式,分别设置了下拉菜单用来切换不同的文件格式;D列和F列分别是改名前和改名后的文件名(不含后缀),并且两列单元格一一对应。

需要注意的点是——

        1)变量 i 的上限为usedrange.count,excel中已使用单元格动辄几十万个,而Integer的范围在-32768~32767之间,因此不可以将 i 定义为整形,而是要定义为范围更大的Long

        2)尽管Dir函数可以定义文件类型,但是为了能够灵活切换不同的文件类型,我做了下拉列表,所以这里文件后缀手动引用E4和G4两个单元格的内容;

        3)F=Dir(文件地址) 这一函数可以查询该地址对应的文件是否存在,存在返回文件名,不存在返回空值,例如 F = Dir("F:\userdata\Desktop\新建文件夹\abc.xls"), 文件存在时F的值为 abc,不存在时F的值为 "";

vba代码如下:

Sub rename()
Dim i As Long
Dim path As String
Dim j As Integer
path = Range("l9")
Dim t As Integer

t = 1

For i = 4 To UsedRange.Count '

If Dir(path & "\" & "*" & "." & Range("e4")) <> "" Then '先检查Dir函数有没有运行完毕,运行到最后一次会返回空值

On Error Resume Next '遇到错误时继续执行
        
F = Dir(path & "\" & Range("f" & i) & "." & Range("g4")) '检查文件夹中有没有与第一个单元格(f4)相同的文件名

j = 2

    While F <> "" '如果有重复文件名则进入循环
    
        Name path & "\" & Range("f" & i) & "." & Range("g4") As path & "\" & Range("f" & i) & "(" & j & ")" & "." & Range("g4") '将名称相同的原始文件命名为“原文件名(j)”
    
        j = j + 1
        
        F = Dir(path & "\" & Range("f" & i) & "." & Range("g4")) '命名后继续检查有没有与“原始文件名(j)”相同的文件名,有则继续循环
        
    Wend

Name path & "\" & Range("d" & i) & "." & Range("e4") As path & "\" & Range("f" & i) & "." & Range("g4") '当不存在重复文件名后,将需要命名的文件重命名为fi单元格的名称

End If

Next '进行下一行的单元格重命名

End Sub

        运行完毕后,文件名中有括号数字的即为原来文件夹中与要命名的文件名重复的文件,没有括号的文件名则是不存在重复的文件。

实例:

【VBA】使用vba进行文件批量重命名(自定义后缀,重复文件自动编号)_第2张图片 要实现的目标

【VBA】使用vba进行文件批量重命名(自定义后缀,重复文件自动编号)_第3张图片 命名前的文件夹 【VBA】使用vba进行文件批量重命名(自定义后缀,重复文件自动编号)_第4张图片 命名后的文件夹

        

    

你可能感兴趣的:(VisualBasic,p2p,蓝桥杯,gnu,vba)