[發問] Application.FileSearch 無法使用

h60327

各位先進此統計表係以office 2003版製作，但因公司更新為office 2010版，其中原有部分功能無法使用
目前知道係因Application.FileSearch無法再使用，經上網查詢可使用dir代替，但自己功力不足仍無法正常執行，
還請各位先進多加指導，很抱歉這是一個word檔但相信程式碼是相通的，若有發錯請見諒

bobomi

http://forum.twbts.com/thread-671-1-1.html
http://forum.twbts.com/viewthrea ... ighlight=FileSearch

h60327

這二則我也都有搜尋到，但是自己卻套用不來，所以才再請教解決方式，不勝感激

stillfish00

回復 3# h60327
寫了一個物件類別模組，只實現你有用到的部分FileSearch功能
使用方法:
1. Project 中插入一個物件類別模組，物件類別模組Name改為clsFileSearch，貼上以下程式碼

1. Private msLookIn As String
   
2. Private msFileName As String
   
3. Private mbSearchSubFolders As Boolean
   
4. Private mcolFoundFiles As Collection
   
5. 
   
6. Private Sub Class_Initialize()
   
7.   Set mcolFoundFiles = New Collection
   
8. End Sub
   
9. 
   
10. Public Property Get LookIn() As String
    
11.   LookIn = msLookIn
    
12. End Property
    
13. Public Property Let LookIn(ByVal sLookIn As String)
    
14.   msLookIn = sLookIn
    
15. End Property
    
16. 
    
17. Public Property Get FileName() As String
    
18.   FileName = msFileName
    
19. End Property
    
20. Public Property Let FileName(ByVal sFileName As String)
    
21.   msFileName = sFileName
    
22. End Property
    
23. 
    
24. Public Property Get SearchSubFolders() As Boolean
    
25.   SearchSubFolders = mbSearchSubFolders
    
26. End Property
    
27. Public Property Let SearchSubFolders(ByVal bSearchSubFolders As Boolean)
    
28.   mbSearchSubFolders = bSearchSubFolders
    
29. End Property
    
30. 
    
31. Public Property Get FoundFiles() As Collection
    
32.   Set FoundFiles = mcolFoundFiles
    
33. End Property
    
34. 
    
35. Public Function Execute() As Long
    
36.   Dim oFSO As Object, oFolder As Object
    
37.   Dim oFile
    
38.   
    
39.   Set oFSO = CreateObject("Scripting.FileSystemObject")
    
40.   Set mcolFoundFiles = New Collection '清空
    
41.   
    
42.   If oFSO.FolderExists(msLookIn) Then
    
43.     Set oFolder = oFSO.GetFolder(msLookIn)
    
44.     For Each oFile In oFolder.Files
    
45.       If oFile.Name Like msFileName Then mcolFoundFiles.Add oFile.Path
    
46.     Next
    
47.    
    
48.     If mbSearchSubFolders Then FindSubFolder oFolder.subfolders
    
49.   End If
    
50.   
    
51.   Execute = mcolFoundFiles.Count
    
52. End Function
    
53. 
    
54. Private Sub FindSubFolder(ByRef oSub As Object)
    
55.   Dim x, oFile
    
56.   For Each x In oSub
    
57.     For Each oFile In x.Files
    
58.       If oFile.Name Like msFileName Then mcolFoundFiles.Add oFile.Path
    
59.     Next
    
60.    
    
61.     FindSubFolder x.subfolders
    
62.   Next  
    
63. End Sub

複製代碼

2. 然後把你的CommandButton1_Click()中的
    Set fs1 = Application.FileSearch
    改成
    Set fs1 = New clsFileSearch

h60327

回復 4# stillfish00
感謝stillfish00前輩的幫忙，終於可以使用，減少很多的統計時間 。