返回列表 上一主題 發帖

[發問] Application.FileSearch 無法使用

回復 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. Private Sub Class_Initialize()
  6.   Set mcolFoundFiles = New Collection
  7. End Sub

  8. Public Property Get LookIn() As String
  9.   LookIn = msLookIn
  10. End Property
  11. Public Property Let LookIn(ByVal sLookIn As String)
  12.   msLookIn = sLookIn
  13. End Property

  14. Public Property Get FileName() As String
  15.   FileName = msFileName
  16. End Property
  17. Public Property Let FileName(ByVal sFileName As String)
  18.   msFileName = sFileName
  19. End Property

  20. Public Property Get SearchSubFolders() As Boolean
  21.   SearchSubFolders = mbSearchSubFolders
  22. End Property
  23. Public Property Let SearchSubFolders(ByVal bSearchSubFolders As Boolean)
  24.   mbSearchSubFolders = bSearchSubFolders
  25. End Property

  26. Public Property Get FoundFiles() As Collection
  27.   Set FoundFiles = mcolFoundFiles
  28. End Property

  29. Public Function Execute() As Long
  30.   Dim oFSO As Object, oFolder As Object
  31.   Dim oFile
  32.   
  33.   Set oFSO = CreateObject("Scripting.FileSystemObject")
  34.   Set mcolFoundFiles = New Collection '清空
  35.   
  36.   If oFSO.FolderExists(msLookIn) Then
  37.     Set oFolder = oFSO.GetFolder(msLookIn)
  38.     For Each oFile In oFolder.Files
  39.       If oFile.Name Like msFileName Then mcolFoundFiles.Add oFile.Path
  40.     Next
  41.    
  42.     If mbSearchSubFolders Then FindSubFolder oFolder.subfolders
  43.   End If
  44.   
  45.   Execute = mcolFoundFiles.Count
  46. End Function

  47. Private Sub FindSubFolder(ByRef oSub As Object)
  48.   Dim x, oFile
  49.   For Each x In oSub
  50.     For Each oFile In x.Files
  51.       If oFile.Name Like msFileName Then mcolFoundFiles.Add oFile.Path
  52.     Next
  53.    
  54.     FindSubFolder x.subfolders
  55.   Next  
  56. End Sub
複製代碼
2. 然後把你的CommandButton1_Click()中的
    Set fs1 = Application.FileSearch
    改成
    Set fs1 = New clsFileSearch
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

        靜思自在 : 待人退一步,愛人寬一寸,就會活得很快樂。
返回列表 上一主題