Office07,2010中的Application.Filesearch替代方法

时　间:2012-05-29 16:51:44
作　者:风行   ID：16058  城市：江阴
摘　要:第一个类，命名为FileSearh： 
正　文:

Dim pLookIn As String Dim pSearchSubFolders As Boolean Dim pFileName As String

Public FoundFiles As New Collection

Public Property Get LookIn() As String

LookIn = pLookIn

End Property

Public Property Let LookIn(value As String)

pLookIn = value

End Property

Public Property Get SearchSubFolders() As Boolean

LookIn = pSearchSubFolders

End Property

Public Property Let SearchSubFolders(value As Boolean)

pSearchSubFolders = value

End Property

Public Property Get fileName() As String

fileName = pFileName

End Property

Public Property Let fileName(value As String)

pFileName = value

End Property

Public Function Execute() As Long

Dim ex As Long

Dim sLookIn As String

Dim sDirName As String

Dim sSubDir As String

Dim sFileName As String

Dim ff As FilesFound

Set ff = New FilesFound

sLookIn = LookIn

sDirName = Dir(sLookIn, vbDirectory)

sFileName = Dir(sLookIn & "\", vbNormal)

Do Until Len(sFileName) = 0

If sFileName Like fileName Then

ff.AddFile sLookIn, sFileName

FoundFiles.Add (ff.FoundFileFullName)

End If

sFileName = Dir

Loop

If SearchSubFolders Then

Do Until Len(sDirName) = 0

If GetAttr(sLookIn & sDirName) = vbDirectory Then

sSubDir = sDirName

Do Until Len(sFileName) = 0

If GetAttr(sDirName) = vbNormal Then

sFileName = sDirName

ff.AddFile sDirName, sFileName

FoundFiles.Add (ff)

End If

Loop

End If

sDirName = Dir

Loop

End If

Execute = FoundFiles.Count

End Function

第二个类，命名为FilesFound ：

Public FoundFileFullName As String

Public Function AddFile(path As String, fileName As String)

FoundFileFullName = path & "\" & fileName

End Function

使用：

 Dim sFile as String

Dim fs As New FileSearh

 With fs

.LookIn = sPath

.SearchSubFolders = True

.fileName = "*"

If .Execute > 0 Then

For i = 1 To .FoundFiles.Count

sFile = .FoundFiles(i)

 ' Your code here

 Next

End If

End With

这种办法虽然相当原来的功能有一些少，但是可以一定程度上减少代码移植的成本。

Access软件网QQ交流群 (群号:483923997) 　　　　　　Access源码网店