Excel VBA：批量对文件任意重命名（移动）

VBA-守候

已于 2022-07-15 02:44:21 修改

阅读量4.2k

点赞数 1

分类专栏： VBA办公自动化文章标签： vba 编程语言自动化开发语言文档资料

于 2022-07-13 22:44:34 首次发布

本文链接：https://blog.csdn.net/qq_64613735/article/details/125774111

版权

VBA办公自动化专栏收录该内容

21 篇文章 13 订阅

订阅专栏

一、普通VBA代码的问题

如果用Dir()方法和MkDir方法，一般只能在已经存在的文件夹内创建一层新的子文件夹。无法命名任意多层文件夹。

也就是说，如现在如果已经存在文件夹【E:\ABC】，才能创建【E:\ABC\DEF】；否则是不能直接创建后面的新文件夹的。

二、创建任意文件夹的思路

1.创建FSO对象【文件系统对象】

用FSO对象主要是因为它处理文件与文件夹更专业，里面有各种函数和方法，不需要自己通过Mkdir/Dir/Split等函数和方法慢慢构造路径；同时避免很多出错的可能。

2.判断盘符是否存在

比如给定需要创建的文件夹是

路径 = "E:\A\b/C\d/ef\g/h\i\j\k/m/n"

利用【FSO.DriveExists()】函数判断给定的路径对应的盘符【E:\】是否存在，如果盘符不存在，是不可能创建出给定文件夹的，此时直接即出程序；否则，继续向下执行程序。

3.循环逐层判断文件夹

关于如果创建多层文件夹，之前有写过一篇文章：

【VBA：用MkDir函数创建多层文件夹】http://t.csdn.cn/2YFUo当时用的VBA自带的Dir()和Mkdir函数，可以参考一下。

而本文用的是另一种方法——FSO对象，更加方便和保险，减少出错。

（1）不存在的文件夹路径存入数组

利用【FSO.FolderExists()】函数，从给定的完整路径开始，逐级向上判断第级文件夹路径是否存在。

判断流程：

第1次，判断【E:\A\b/C\d/ef\g/h\i\j\k/m/n】是否存在
第2次，判断【E:\A\b/C\d/ef\g/h\i\j\k/m】是否存在
第3次，判断【E:\A\b/C\d/ef\g/h\i\j\k】是否存在
……
第n次，判断【E:\A】是否存在

A.如果不存在，则装入一个动态数组arr中；

B.如果该级文件夹路径存在，则往上肯定都存在了，就不再向上一级父文件夹进行判断。

（2）倒着循环arr

即从上面记录文件夹路径的数组arr的最大下标开始循环，直到最小下标结束，步长-1。

因为我们创建文件夹，是要按下面箭头所示的顺序由下向上逐级来操作的：

（3）创建文件夹

用【FSO.CreateFolder】方法逐级创建文件夹

（4）完成

循环arr完成，多层文件夹创建完成

三、创建任意多层文件夹示例代码

Sub 创建任意文件目录主程序()
    Dim 路径 As String
    路径 = "E:\A\b/C\d/ef\g/h\i\j\k/m/n" '只要此处所写的路径的盘符【E:\】在电脑存在，就能创建成功
    Call fsoCreatAnyFolder(路径)
End Sub
Sub fsoCreatAnyFolder(路径)
    Dim FSO As Object
    Dim p As String
    Dim s As String
    Dim arr() As String
    Dim i As Integer
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    p = Replace(folderToCreate, "/", "\")
    
    If Not FSO.DriveExists(Left(p, 3)) Then
        Debug.Print "错误：盘符不存在！"
        Set FSO = Nothing
        Exit Sub
    End If
    
    s = p
    Do While Not FSO.FolderExists(s)
        i = i + 1
        ReDim Preserve arr(1 To i)
        arr(i) = s
        s = FSO.GetParentFolderName(s)
    Loop
    
    For i = UBound(arr) To LBound(arr) Step -1
        FSO.CreateFolder (arr(i))
        Debug.Print arr(i)
    Next
    
    Set FSO = Nothing
End Sub

四、批量对文件任意重命名

在上述创建多层文件夹的方法的基础上，咱们可以对已经存在的文件任意移动或重命名

操作方法：

1.整理新旧文件名

在Excel的【Sheet1】表格和A列写原文件完整路径，B列写新文件名的完整路径

注：第一行是标题不会算在内

2.执行

点击【Sheet1】表格里的【执行】按钮，即可完成。

或者打开文件，在代码主程序处点击运行也一样。

3.示例代码

Sub 重命名(原文件名 As String, 新文件名 As String)
    Dim FSO As Object
    Dim 原文件夹 As String
    Dim 新文件夹 As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If Not FSO.FileExists(原文件名) Then Exit Sub
    
    If FSO.DriveExists(Left(新文件名, 3)) Then
        新文件夹 = Replace(新文件名, FSO.GetFileName(新文件名), "")
        If Not FSO.FolderExists(新文件夹) Then
            fsoCreatAnyFolder 新文件夹
        End If
        
        Name 原文件名 As 新文件名
    End If
    
    Set FSO = Nothing
End Sub

Sub fsoCreatAnyFolder(folderToCreate As String)
    Dim FSO As Object
    Dim p As String
    Dim s As String
    Dim arr() As String
    Dim i As Integer
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    p = Replace(folderToCreate, "/", "\")
    
    If Not FSO.DriveExists(Left(p, 3)) Then
        Debug.Print "错误：盘符不存在！"
        Set FSO = Nothing
        Exit Sub
    End If
    
    s = p
    Do While Not FSO.FolderExists(s)
        i = i + 1
        ReDim Preserve arr(1 To i)
        arr(i) = s
        s = FSO.GetParentFolderName(s)
    Loop
    
    For i = UBound(arr) To LBound(arr) Step -1
        FSO.CreateFolder (arr(i))
        Debug.Print arr(i)
    Next
    
    Set FSO = Nothing
End Sub

Rem 注意：
    '1. 此处以下是主程序，光标定位在主程序任何位置，点击运行即可
    '2. 新旧文件路径分别放在表格名为【Sheet1】的表格的【A列】和【B列】
    '3. 表格第一行为标题行，不算数据
    '4. 都必须为绝对路径，不可省略
Sub 批量重命名主程序()
    Dim arr
    Dim i As Long
    arr = Sheets("Sheet1").Cells(1, 1).CurrentRegion.Value
    For i = LBound(arr, 1) + 1 To UBound(arr)
        Call 重命名(CStr(arr(i, 1)), CStr(arr(i, 2)))
        Debug.Print arr(i, 1), " 已经命名为 ", arr(i, 2)
    Next
    MsgBox Format(UBound(arr) - LBound(arr), "完成 共处理了0个文件")
End Sub

五、文件

链接: https://pan.baidu.com/s/1zKAlHsCTd8fU33cxMVgtGw?pwd=uhsi 提取码: uhsi 复制这段内容后打开百度网盘手机App，操作更方便哦

打开文件直接操作即可。

VBA-守候

关注

1
点赞
踩
17

收藏

觉得还不错? 一键收藏
打赏
0
评论
Excel VBA：批量对文件任意重命名（移动）

如果用Dir()方法和MkDir方法，一般只能在已经存在的文件夹内创建一层新的子文件夹。无法命名任意多层文件夹。也就是说，如现在如果已经存在文件夹【E:\ABC】，才能创建【E:\ABC\DEF】；否则是不能直接创建后面的新文件夹的。用FSO对象主要是因为它处理文件与文件夹更专业，里面有各种函数和方法，不需要自己通过Mkdir/Dir/Split等函数和方法慢慢构造路径；同时避免很多出错的可能。比如给定需要创建的文件夹是利用【FSO.DriveExists()】函数判断给定的路径对应的盘符【E:\】是否存在
复制链接

扫一扫