遍历文件夹中文件

​Sub LoopAllExcelFilesInFolder()

Dim wb As Workbook

Dim myPath As String

Dim myFile As String

Dim myExtension As String

Dim FldrPicker As FileDialog

'这里很关键，决定宏执行快慢的关键

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.Calculation = xlCalculationManual

'打开目录选择框

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker

.Title = "请选择目录"

.AllowMultiSelect = False

If .Show <> -1 Then GoTo NextCode

myPath = .SelectedItems(1) & "\"

End With

'取消选择

NextCode:

myPath = myPath

If myPath = "" Then GoTo ResetSettings

'指定过滤的文件后缀

myExtension = "*.xls*"

'遍历全路径

myFile = Dir(myPath & myExtension)

'循环处理每一个文件

Do While myFile <> ""

'打开

Set wb = Workbooks.Open(Filename:=myPath & myFile)

'确保工作簿被打开，在处理下一个文件时

DoEvents

'设置背景色

wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

'保存工作簿

wb.Close SaveChanges:=True

'确保工作簿被关闭，在处理下一个文件时

DoEvents

'接着处理下一个

myFile = Dir

Loop

'提示处理完成

MsgBox "处理完成!"

ResetSettings:

'恢复设置

Application.EnableEvents = True

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub