vba老手都知道,vba寫多了,其實都是在做循環。
循環處理多個單元格的內容,循環處理多個工作表的內容,循環處理多個工作簿的內容。
其中又以循環處理多個文件最為頻繁,一個excel工作簿內的內容循環有些人還可以藉助函數來實現,但是涉及到多個文件的循環處理時,用函數就顯得無力回天,這時候就需要祭出vba大招了。
我們經常遇到的是這樣的場景,需要處理的數據位於多個不同的文件,這時候就涉及到對每個文件的逐一讀取,也就是遍歷文件。
在vba中遍歷文件可以有多種方法,有用dir函數遍歷的,也有用FileSystemObject對象遍歷的,對比之下,用FileSystemObject對象功能齊全,可以延伸做其它事情。
以下是一個通用的遍歷文件夾下的文件的代碼,可以包含是否遍歷子文件夾:
Sub begin() Excel.Application.ScreenUpdating = False Excel.Application.DisplayAlerts = False Excel.Application.Calculation = xlCalculationManual Dim sPath As String '選擇要操作的文件夾 sPath = GetPath() If Len(sPath) Then '開始遍歷選中的文件夾中的所有文件 EnuAllFiles sPath, False MsgBox "操作完成!!!" End If Excel.Application.Calculation = xlCalculationAutomatic Excel.Application.DisplayAlerts = True Excel.Application.ScreenUpdating = TrueEnd Sub'遍歷文件夾及其子文件夾的通用過程,'sPath參數表示要遍歷的文件夾的路徑,bEnuSub可選參數表示是否遍歷子文件夾,不提供表示不遍歷子文件夾'QQ:1722187970,微信:xycgenius,公眾號:水星excelSub EnuAllFiles(ByVal sPath As String, Optional bEnuSub As Boolean = False) '定義文件系統對象 Dim oFso As Object Set oFso = CreateObject("Scripting.FileSystemObject") '定義文件夾對象 Dim oFolder As Object Set oFolder = oFso.GetFolder(sPath) '定義文件對象 Dim oFile As Object Dim oWB As Workbook Dim oWK As Worksheet Dim oWB1 As Workbook Dim oWK1 As Worksheet Set oWB = Excel.ThisWorkbook Set oWK = oWB.Worksheets(1) iRow = oWK.Range("A65536").End(xlUp).Row '如果指定的文件夾含有文件 If oFolder.Files.Count Then For Each oFile In oFolder.Files With oFile '輸出文件所在的盤符 Dim sDrive As String sDrive = .Drive '輸出文件的類型 Dim sType As String sType = .Type '輸出含後綴名的文件名稱 Dim sName As String sName = .Name '輸出含文件名的完整路徑 Dim sFilePath As String sFilePath = .Path '輸出文件的上次修改時間 Dim dDLM dDLM = .DateLastModified '輸出文件的上次訪問時間 Dim dDLA dDLA = .DateLastAccessed '輸出文件的創建時間 Dim dDC dDC = .DateCreated '輸出文件的屬性 Dim sATT sATT = .Attributes '如果文件是Excel文件且不是隱藏文件 If sType Like "*Excel*" And Not (sName Like "*~$*") Then Set oWB1 = Excel.Workbooks.Open(sFilePath) With oWB1 Set oWK1 = .Worksheets(1) With oWK1 iRow = .Range("a65536").End(xlUp).Row '*********************************** '其它操作代碼 '*********************************** End With Excel.Application.Calculation = xlCalculationAutomatic .Close End With Else
End If End With Next '如果指定的文件夾不含有文件 Else End If '如果要遍歷子文件夾 If bEnuSub = True Then '定義子文件夾集合對象 Dim oSubFolders As Object Set oSubFolders = oFolder.SubFolders If oSubFolders.Count > 0 Then For Each oTempFolder In oSubFolders sTempPath = oTempFolder.Path Call EnuAllFiles(sTempPath, True) Next End If Set oSubFolders = Nothing End If Set oFile = Nothing Set oFolder = Nothing Set oFso = NothingEnd SubFunction GetPath() As String '聲明一個FileDialog對象變量 Dim oFD As FileDialog' '創建一個選擇文件對話框' Set oFD = Application.FileDialog(msoFileDialogFilePicker) '創建一個選擇文件夾對話框 Set oFD = Application.FileDialog(msoFileDialogFolderPicker) '聲明一個變量用來存儲選擇的文件名或者文件夾名稱 Dim vrtSelectedItem As Variant With oFD '允許選擇多個文件 .AllowMultiSelect = True '使用Show方法顯示對話框,如果單擊了確定按鈕則返回-1。 If .Show = -1 Then '遍歷所有選擇的文件 For Each vrtSelectedItem In .SelectedItems '獲取所有選擇的文件的完整路徑,用於各種操作 GetPath = vrtSelectedItem Next '如果單擊了取消按鈕則返回0 Else End If End With '釋放對象變量 Set oFD = NothingEnd Function上述代碼通過遞歸的方式逐級遍歷文件夾及其子文件,通過參數的設置可以選擇是否遍歷子文件夾。
基本上可以解決任何遍歷文件夾的需求。
在看和轉發分享就是最大的支持