使用VBA循环浏览文件夹中的文件？
我想在Excel 2010中使用vba循环查看目录的文件。
在循环中，我将需要
- 文件名和
- 文件被格式化的date。
我已经编码以下工作正常，如果该文件夹没有更多的50个文件，否则它是可笑的慢（我需要它与> 10000文件的文件夹）。 这个代码的唯一问题是查找file.name的操作需要非常多的时间。
代码工作，但waaaaaay太慢（每100个文件15秒）：
Sub LoopThroughFiles() Dim MyObj As Object, MySource As Object, file As Variant Set MySource = MyObj.GetFolder("c:\testfolder\") For Each file In MySource.Files If InStr(file.name, "test") > 0 Then MsgBox "found" Exit Sub End If Next file End Sub
问题解决了：
- 我的问题已经通过下面的解决scheme使用
Dir以特定方式解决（15000个文件为20秒），并使用命令FileDateTime检查时间戳。 - 考虑到从20秒以下的另一个答案减less到不到1秒。
这是我作为一个函数的解释：
'####################################################################### '# LoopThroughFiles '# Function to Loop through files in current directory and return filenames '# Usage: LoopThroughFiles ActiveWorkbook.Path, "txt" 'inputDirectoryToScanForFile '# https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba '####################################################################### Function LoopThroughFiles(inputDirectoryToScanForFile, filenameCriteria) As String Dim StrFile As String 'Debug.Print "in LoopThroughFiles. inputDirectoryToScanForFile: ", inputDirectoryToScanForFile StrFile = Dir(inputDirectoryToScanForFile & "\*" & filenameCriteria) Do While Len(StrFile) > 0 Debug.Print StrFile StrFile = Dir Loop End Function
Dir通配符，所以你可以做出很大的改变，增加前面的testfilter，避免testing每个文件
Sub LoopThroughFiles() Dim StrFile As String StrFile = Dir("c:\testfolder\*test*") Do While Len(StrFile) > 0 Debug.Print StrFile StrFile = Dir Loop End Sub
迪尔似乎非常快。
Sub LoopThroughFiles() Dim MyObj As Object, MySource As Object, file As Variant file = Dir("c:\testfolder\") While (file <> "") If InStr(file, "test") > 0 Then MsgBox "found " & file Exit Sub End If file = Dir Wend End Sub
Dir函数是要走的路，但是问题在于你不能直接使用Dir函数 ，就像这里所说的那样。
我处理这个的方法是使用Dir函数获取目标文件夹的所有子文件夹，并将它们加载到数组中，然后将该数组传递给一个recursion函数。
这是我写的一个类来完成这个任务，它包括searchfilter的能力。 （ 你必须原谅匈牙利符号，这是写在愤怒之时。 ）
Private m_asFilters() As String Private m_asFiles As Variant Private m_lNext As Long Private m_lMax As Long Public Function GetFileList(ByVal ParentDir As String, Optional ByVal sSearch As String, Optional ByVal Deep As Boolean = True) As Variant m_lNext = 0 m_lMax = 0 ReDim m_asFiles(0) If Len(sSearch) Then m_asFilters() = Split(sSearch, "|") Else ReDim m_asFilters(0) End If If Deep Then Call RecursiveAddFiles(ParentDir) Else Call AddFiles(ParentDir) End If If m_lNext Then ReDim Preserve m_asFiles(m_lNext - 1) GetFileList = m_asFiles End If End Function Private Sub RecursiveAddFiles(ByVal ParentDir As String) Dim asDirs() As String Dim l As Long On Error GoTo ErrRecursiveAddFiles 'Add the files in 'this' directory! Call AddFiles(ParentDir) ReDim asDirs(-1 To -1) asDirs = GetDirList(ParentDir) For l = 0 To UBound(asDirs) Call RecursiveAddFiles(asDirs(l)) Next l On Error GoTo 0 Exit Sub ErrRecursiveAddFiles: End Sub Private Function GetDirList(ByVal ParentDir As String) As String() Dim sDir As String Dim asRet() As String Dim l As Long Dim lMax As Long If Right(ParentDir, 1) <> "\" Then ParentDir = ParentDir & "\" End If sDir = Dir(ParentDir, vbDirectory Or vbHidden Or vbSystem) Do While Len(sDir) If GetAttr(ParentDir & sDir) And vbDirectory Then If Not (sDir = "." Or sDir = "..") Then If l >= lMax Then lMax = lMax + 10 ReDim Preserve asRet(lMax) End If asRet(l) = ParentDir & sDir l = l + 1 End If End If sDir = Dir Loop If l Then ReDim Preserve asRet(l - 1) GetDirList = asRet() End If End Function Private Sub AddFiles(ByVal ParentDir As String) Dim sFile As String Dim l As Long If Right(ParentDir, 1) <> "\" Then ParentDir = ParentDir & "\" End If For l = 0 To UBound(m_asFilters) sFile = Dir(ParentDir & "\" & m_asFilters(l), vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) Do While Len(sFile) If Not (sFile = "." Or sFile = "..") Then If m_lNext >= m_lMax Then m_lMax = m_lMax + 100 ReDim Preserve m_asFiles(m_lMax) End If m_asFiles(m_lNext) = ParentDir & sFile m_lNext = m_lNext + 1 End If sFile = Dir Loop Next l End Sub
当我处理和处理来自其他文件夹的文件时， Dir函数很容易失去焦点。
我用组件FileSystemObject得到了更好的结果。
完整的例子在这里给出：
http://www.xl-central.com/list-files-fso.html
不要忘记在Visual Basic编辑器中为Microsoft Scripting Runtime设置一个引用（通过使用工具>引用）
试一试！
