学习Excel技术，关注微信公众号：
excelperfect
在文件夹中所有文件上运行宏，或者在Excel工作簿中所有工作表上运行宏，这可能是一种非常好的Excel自动化方案。例如处理类似的数据工作簿文件并想要提取数据或转换该工作簿。下面给出了适用这种情况的一些VBA程序，这些程序代码整理自analystcave.com，供有兴趣的朋友参考。
在文件夹内所有文件中运行宏
代码如下：
代码语言：javascript复制'本程序来自于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集合中存储的文件上运行所有宏之后。
代码如下：
代码语言：javascript复制'本程序来自于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在工作簿所有工作表中运行宏
代码如下：
代码语言：javascript复制'本程序来自于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.使用要在每个打开的工作表上运行的任何代码替换“在这里放置你的代码”部分。
