Excel VBA和文件夹-1.12更改文件名

前景提要

在我的计划中，本篇是VBA和文件夹这一系列的最后一篇分享了，按照我自己学习的过程中，到这里基本上应该能够应付日常工作中关于文件夹方面的操作需求了，今天分享的内容是如何通过VBA更改文件夹的名字，这个操作也是比较常用的，比方说当你汇总完了某个文件夹之后，你想要将文件夹标注成为已经汇总过的，这样方便日后的查看和记录，又或者比方说有一批来自各个部门的不同岗位的业务汇总的文件夹，你想要通过文件夹的名字进行更快速的整理，这个时候也可以使用本方法。。。。我比较常用的就这两个场景，可能因为我工作的岗位接触的比较狭隘吧，好了，进入正题。

思路

依然是先说下思路，其实不管是做什么事情，有思路有方向还是最重要的，尤其是在编程，写脚本的这个环节上面，更加强调逻辑的重要性了，既然我们要更改文件夹的名字，我们需要知道文件夹的原名字，然后还要知道改进后的名字，然后改一下就好了，这个改一下的改如何实现呢？name .....as .......就可以实现。有了思路，方法，走，敲代码去。

上代码

Sub test()

Dim OldName$, NewName$, i&, FileName

With Application.FileDialog(msoFileDialogFilePicker)

    If .Show = -1 Then

        For i = 1 To .SelectedItems.Count

            Workbooks.Open .SelectedItems(i)

            pathn = Application.ActiveWorkbook.Path

            OldName = .SelectedItems(i)

            biggst = UBound(Split(OldName, "\"))

            FileName = Split(OldName, "\")(biggst)

            NewName = "AAA" & FileName

            NewName = pathn & "\" & NewName

            ActiveWorkbook.Close True

            Name OldName As NewName

        Next i

    End If

End With

End Sub

效果如图：

更改前

1.jpg

更改后

2.jpg

从效果图中我们就可以看到已经实现了效果了，所有的文件的前面都多了AAA.

代码分析

一上来还是利用我们学过的filediajog来自主选择文件，然后通过

pathn = Application.ActiveWorkbook.Path

方法获取文件的路径

剩下的白遍历打开就是我们之前学习过的内容了，一直到最后面，获得了文件名之后，通过

Name OldName As NewName

来实现重命名，这里要注意的是，旧的文件名在前面，新的在后面。

完整代码+注释

Sub test()

Dim OldName$, NewName$, i&, FileName '声明变量

With Application.FileDialog(msoFileDialogFilePicker) '选择文件

    If .Show = -1 Then

        For i = 1 To .SelectedItems.Count '开始遍历选择文件

            Workbooks.Open .SelectedItems(i)

            pathn = Application.ActiveWorkbook.Path '通过打开的方式获得当前的路径

            OldName = .SelectedItems(i) '获取就的文件名

            biggst = UBound(Split(OldName, "\")) '通过“\”拆分路径，得到最大下标，方便后面获取文件名

            FileName = Split(OldName, "\")(biggst) '通过最大下表，获取文件名

            NewName = "AAA" & FileName

            NewName = pathn & "\" & NewName '将新的文件名和路径组合，形成完成路径

            ActiveWorkbook.Close True

            Name OldName As NewName '重命名

        Next i

    End If

End With

End Sub