置頂公眾號，否則不能及時收到新文章

推薦給朋友，讓朋友也能收到免費文章

在公眾號發送函數或應用的關鍵字，即可免費獲取對應教程

一、功能說明我們在日常辦公的時候，經常會碰到文件名不規范，想要整理很不方便，如果一個個修改文件或者文件夾名稱吧，很麻煩。本工具就是用VBA實現，先提取原文件或文件夾名，然后把想我名字先輸入到工作表中，再運行就可以完成修改名稱了。二、使用說明運行“文件(夾)批量改名”工作簿，就會打開工作表，在工作表中制作了按鈕。先點“名稱列表”，提取原文件或文件夾名到A列，然后在B列輸入想要的名稱，再點“批量改名”按鈕就自動完成了文件或文件夾名稱的批量修改了。注意：如果是要批量修改文件名，就在“改名設置”欄下面選“文件改名”選項；果是要批量修改文件夾名，就在“改名設置”欄下面選“文件夾改名”選項。

三、主要代碼1、文件批量改名代碼：Sub 列出所有文件名() Dim A%, X% On Error GoTo AAA A = [A65536].End(xlUp).Row If A > 1 Then: Range("A2:B" & A).ClearContents Dim xlsFile As String, XX As String XX = Range("C2").Text xlsFile = Dir(ActiveWorkbook.Path & "\" & XX) Do If InStr(1, xlsFile, ThisWorkbook.Name) = 0 Then Cells(([A65536].End(xlUp).Row + 1), 1) = xlsFile End If xlsFile = Dir Loop Until Len(xlsFile) = 0 X = Range("A65536").End(xlUp).Row Range(Range("B2"), Range("B" & X)).Value = Range(Range("A2"), Range("A" & X)).Value MsgBox "完成" Exit SubAAA: MsgBox "沒有該類型的文件，請重新選擇文件類型試試！"End SubSub 文件批量改名() Dim X%, Y% X = [A65536].End(xlUp).Row On Error Resume Next For Y = 2 To X If Cells(Y, 2) <> "" Then Name ActiveWorkbook.Path & "\" & Cells(Y, 1) As ActiveWorkbook.Path & "\" & Cells(Y, 2) End If Next MsgBox "完成"End?Sub2、文件夾批量改名代碼：Sub 列出所有文件夾名() On Error Resume Next Dim A%, X% Dim dd As String Dim k% On Error Resume Next A = Range("A65536").End(xlUp).Row If A > 1 Then: Range("A2:B" & A).ClearContents Dim xlsFile As String, XX As String XX = Range("C2").Text ''提取文件夾名稱 dd = Dir(ThisWorkbook.Path & "\*", vbDirectory) Do dd = Dir ''判斷是否為文件夾 If dd <> "" And InStr(1, dd, ".") = 0 Then Dim aa Set aa = CreateObject("Scripting.FileSystemObject") k = k + 1 Cells((Range("A65536").End(xlUp).Row + 1), 1) = dd End If Loop Until Len(dd) = 0 If k = 0 Then: GoTo BBB X = Range("A65536").End(xlUp).Row Range(Range("B2"), Range("B" & X)).Value = Range(Range("A2"), Range("A" & X)).Value MsgBox "完成" Exit SubBBB: MsgBox "沒有文件夾，請你新建幾個文件夾試試！" Set aa = NothingEnd SubSub 文件夾批量改名() Dim X%, Y% X = Range("A65536").End(xlUp).Row On Error Resume Next Set aa = CreateObject("Scripting.FileSystemObject") For Y = 2 To X If Cells(Y, 2) <> "" Then ''文件夾重命名 aa.MoveFolder ThisWorkbook.Path & "\" & Cells(Y, 1), ThisWorkbook.Path & "\" & Cells(Y, 2) End If Next Set aa = Nothing MsgBox "完成"End?Sub3、工作表內按鈕代碼：Sub 名稱列表() With Sheet1.Range("C3") If .Value = 1 Then Call 列出所有文件名 Else Call 列出所有文件夾名 End If End WithEnd SubSub 批量改名() With Sheet1.Range("C3") If .Value = 1 Then Call 文件批量改名 Else Call 文件夾批量改名 End If End WithEnd SubSub 文件改名_單擊() ActiveSheet.Shapes("文件類型").Visible = TrueEnd SubSub 文件夾改名_單擊() ActiveSheet.Shapes("文件類型").Visible = FalseEnd?Sub四、工具下載關注本公眾號后，在公眾號聊天窗口發送XSS002，系統會自動回復給你下載地址。

如果你是新朋友，長按下面二維碼 -->?前往圖中包含的公眾號?-->?關注公眾號，就可以跟謝順勝一起研究Excel在工程中的應用了。

微信公眾號(ID:ExcelGcYy)

個人微信號(ID: hhzjxss)

進入公眾號發送函數或工程應用的名稱關鍵詞，即可免費獲得相關教程

---

? ? ? ? 本公眾目前未能提供下載，如果需要下載Excel文件的，可以加入【Excel工程應用技巧群】QQ群(218089918)，到群文件夾中下載文件。

總結

以上是生活随笔為你收集整理的mac 批量清空文件夹文件_【XSS 聚宝瓶】文件及文件夹批量改名工具的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。