我想使用 Excel 2010 中的 vba 循环遍历目录的文件。在循环中，我需要：文件名和文件格式化的日期。我已编写了以下代码...
Excel 2010 中的 vba 循环遍历目录的文件
在循环中，我需要：
我编写了以下代码，如果文件夹中的文件不超过 50 个，则运行良好，否则速度会非常慢（我需要它处理包含超过 10000 个文件的文件夹）。此代码的唯一问题是查找操作 file.name 需要花费大量时间。
代码可以运行但是速度太慢了（每 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
问题解决：
Dir 特定方式（15000 个文件需要 20 秒）并使用命令检查时间戳 FileDateTime .
Dir 函数是可行的方法，但 the problem is that you cannot use the Dir function recursively ，如此处所述 ，在底部 .
我处理这个问题的方法是使用函数 Dir 获取目标文件夹的所有子文件夹并将它们加载到数组中，然后将数组传递到递归函数中。
这是我编写的一个可以实现此功能的一个类，它包括搜索过滤器的功能。（ 您必须原谅匈牙利表示法，因为它是在匈牙利表示法风靡一时时编写的。） )
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