VBA實用小程式61： 在文件夾內所有文件中運行宏/在工作簿所有工作表中運行宏
- 2019 年 12 月 12 日
- 筆記
學習Excel技術，關注微信公眾號：
excelperfect
在文件夾中所有文件上運行宏，或者在Excel工作簿中所有工作表上運行宏，這可能是一種非常好的Excel自動化方案。例如處理類似的數據工作簿文件並想要提取數據或轉換該工作簿。下面給出了適用這種情況的一些VBA程式，這些程式程式碼整理自analystcave.com，供有興趣的朋友參考。
在文件夾內所有文件中運行宏
程式碼如下：
'本程式來自於analystcave.com Sub RunOnAllFilesInFolder() Dim folderName As String Dim eApp As Excel.Application Dim fileName As String Dim wb As Workbook Dim ws As Worksheet Dim currWs As Worksheet Dim currWb As Workbook Dim fDialog As Object Set fDialog =Application.FileDialog(msoFileDialogFolderPicker) Set currWb =ActiveWorkbook Set currWs = ActiveSheet '選擇存儲所有文件的文件夾 fDialog.Title = "選擇文件夾" fDialog.InitialFileName =currWb.Path If fDialog.Show = -1 Then folderName =fDialog.SelectedItems(1) End If '創建一個單獨的不可見的Excel處理進程 Set eApp = NewExcel.Application eApp.Visible = False '搜索文件夾中的所有文件[使用你的格式例如*.xlsx來代替*.*] fileName = Dir(folderName& "*.*") Do While fileName<> "" '更新狀態欄來指示進度 Application.StatusBar= "正在處理" & folderName & "" & fileName Set wb =eApp.Workbooks.Open(folderName & "" & fileName) '... '在這裡放置你的程式碼 '... wb.CloseSaveChanges:=False '關閉打開的工作簿 Debug.Print "已處理 "& folderName & "" & fileName fileName = Dir() Loop eApp.Quit Set eApp = Nothing '清除狀態欄並通知宏已完成 Application.StatusBar ="" MsgBox "在所有工作簿中都完成了宏執行" End Sub
這段程式碼完成下列操作：
1.在當前工作簿路徑中打開「選擇文件」對話框，要求選擇一個用於存儲所有文件的文件夾。
2.打開一個單獨的Excel進程（應用程式），然後逐個打開每個文件。
3.使用要在每個打開的工作簿上運行的程式碼替換「在這裡放置你的程式碼」部分。
4.每個打開的工作簿在關閉時不會保存所作的修改。
在子文件夾內所有文件中運行宏
當想在文件夾中所有Excel文件上運行宏時，其中的一種情況是遍歷所有子文件夾來運行宏。下面的內容與前述內容幾乎相同，但是請注意聲明了一個全局變數fileCollection，這將首先用於存儲子文件夾中標識的所有文件，並且僅用於在此VBA集合中存儲的文件上運行所有宏之後。
程式碼如下：
'本程式來自於analystcave.com Dim fileCollection As Collection Sub TraversePath(path As String) Dim currentPath As String Dim directory As Variant Dim dirCollection AsCollection Set dirCollection = NewCollection currentPath = Dir(path,vbDirectory) '瀏覽當前目錄 Do Until currentPath =vbNullString Debug.PrintcurrentPath If Left(currentPath,1) <> "." And (GetAttr(path & currentPath) And vbDirectory)= vbDirectory Then dirCollection.AddcurrentPath ElseIfLeft(currentPath, 1) <> "." And (GetAttr(path ¤tPath) And vbNormal) = vbNormal Then fileCollection.Add path & currentPath End If currentPath = Dir() Loop '瀏覽子目錄 For Each directory IndirCollection Debug.Print "---子目錄: "& directory & "---" TraversePath path& directory & "" Next directory End Sub Sub RunOnAllFilesInSubFolders() Dim folderName As String Dim eApp As Excel.Application Dim fileName As Variant Dim wb As Workbook Dim ws As Worksheet Dim currWs As Worksheet Dim currWb As Workbook Dim fDialog As Object Set fDialog =Application.FileDialog(msoFileDialogFolderPicker) Set currWb =ActiveWorkbook Set currWs = ActiveSheet '選擇存儲所有文件的文件夾 fDialog.Title = "選擇文件夾" fDialog.InitialFileName =currWb.path If fDialog.Show = -1 Then folderName =fDialog.SelectedItems(1) End If '創建一個單獨的不可見的Excel處理進程 Set eApp = NewExcel.Application eApp.Visible = False '搜索文件夾中的所有文件[使用你的格式例如*.xlsx來代替*.*] Set fileCollection = NewCollection TraversePath folderName& "" For Each fileName InfileCollection '更新狀態欄來指示進度 Application.StatusBar= "正在處理" & fileName Set wb =eApp.Workbooks.Open(fileName) '... '在這裡放置你的程式碼. '... wb.CloseSaveChanges:=False '關閉打開的工作簿 Debug.Print "已處理 "& fileName '在立即窗口列印已處理 Next fileName eApp.Quit Set eApp = Nothing '清除狀態欄並通知宏已完成 Application.StatusBar ="" MsgBox "在所有工作簿中都完成了宏執行" End Sub
在工作簿所有工作表中運行宏
程式碼如下：
'本程式來自於analystcave.com Sub RunOnAllWorksheets() Dim folderName As String Dim eApp AsExcel.Application Dim fileName As String Dim ws As Worksheet Dim currWs As Worksheet Dim currWb As Workbook Dim fDialog As Object Set fDialog =Application.FileDialog(msoFileDialogFolderPicker) Set currWb =ActiveWorkbook Set currWs = ActiveSheet '搜索文件夾中的所有文件[使用你的格式例如*.xlsx來代替*.*] For Each ws In Sheets If ws.Name <>currWs.Name Then '更新狀態欄來指示進度 Application.StatusBar = "正在處理 "& ws.Name '... '在這裡放置你的程式碼 '... Debug.Print"已處理" & ws.Name End If Next ws '清除狀態欄並通知宏已完成 Application.StatusBar ="" MsgBox "在所有工作表中已完成宏執行" End Sub
程式碼中：
1.打開ActiveWorkbook中的每個工作表而不是ActiveSheet，可以根據需要刪除If語句。
2.使用要在每個打開的工作表上運行的任何程式碼替換「在這裡放置你的程式碼」部分。
