返回列表 上一主題 發帖

[發問] Application.FileSearch 無法使用

[發問] Application.FileSearch 無法使用

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

123.rar (16.71 KB)

TOP

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

TOP

回復 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

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

TOP

        靜思自在 : 話多不如話少,話少不如話好。
返回列表 上一主題