使用VBA循環(huán)遍歷文件夾中的文件？我想使用以下方法循環(huán)遍歷目錄的文件VBA在Excel 2010中。在循環(huán)中，我需要文件名格式化文件的日期。我已經(jīng)編寫了以下代碼，如果文件夾中沒有超過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 fileEnd Sub解決問題：下面的解決方案已經(jīng)解決了我的問題Dir以一種特定的方式(對于15000個文件使用20秒)和使用命令檢查時間戳FileDateTime.考慮到另一個答案，從下面的20秒減少到不到1秒。
4 回答
天涯盡頭無女友
TA貢獻1831條經(jīng)驗 獲得超9個贊
Dirtest
Sub LoopThroughFiles()
Dim StrFile As String
StrFile = Dir("c:\testfolder\*test*")
Do While Len(StrFile) > 0
Debug.Print StrFile
StrFile = Dir LoopEnd Sub
湖上湖
TA貢獻2003條經(jīng)驗 獲得超2個贊
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 WendEnd Sub
慕容708150
TA貢獻1831條經(jīng)驗 獲得超4個贊
Dir
Dir
Private m_asFilters() As StringPrivate m_asFiles As VariantPrivate m_lNext As LongPrivate m_lMax As LongPublic 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 IfEnd FunctionPrivate 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 0Exit SubErrRecursiveAddFiles:End SubPrivate 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 IfEnd FunctionPrivate 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 lEnd Sub
- 4 回答
- 0 關注
- 3726 瀏覽
添加回答
舉報
0/150
提交
取消