vba 遍历指定文件夹(含子目录)获取文件名,哪种方法速度最快?
2个回答
展开全部
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
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
展开全部
Sub 选择文件夹()
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker) '运行后出现标准的选择文件夹对话框
If .Show Then myPath = .SelectedItems(1) Else Exit Sub '如选中则返回=-1 / 取消未选则返回=0
End With
If Right(myPath, 1) <> "" Then myPath = myPath & ""
'返回的是选中目标文件夹的绝对路径,但除了本地C盘、D盘会以"C:"形式返回外,其余路径无""需要自己添加
Getfd (myPath)
Application.ScreenUpdating = True
End Sub
Sub Getfd(ByVal pth)
Dim Fn$, N%
Fn = Dir(pth & "\*.*")
While Fn <> ""
N = N + 1
Range("A" & N) = Fn
Fn = Dir
Wend
End Sub
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker) '运行后出现标准的选择文件夹对话框
If .Show Then myPath = .SelectedItems(1) Else Exit Sub '如选中则返回=-1 / 取消未选则返回=0
End With
If Right(myPath, 1) <> "" Then myPath = myPath & ""
'返回的是选中目标文件夹的绝对路径,但除了本地C盘、D盘会以"C:"形式返回外,其余路径无""需要自己添加
Getfd (myPath)
Application.ScreenUpdating = True
End Sub
Sub Getfd(ByVal pth)
Dim Fn$, N%
Fn = Dir(pth & "\*.*")
While Fn <> ""
N = N + 1
Range("A" & N) = Fn
Fn = Dir
Wend
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询