Board logo

標題: [發問] Application.FileSearch 無法使用 [打印本頁]
作者: h60327    時間: 2014-11-5 20:45     標題: Application.FileSearch 無法使用

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

http://forum.twbts.com/thread-671-1-1.html
http://forum.twbts.com/viewthrea ... ighlight=FileSearch
作者: h60327    時間: 2014-11-6 08:42

這二則我也都有搜尋到，但是自己卻套用不來，所以才再請教解決方式，不勝感激
作者: stillfish00    時間: 2014-11-6 16:08

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

  6. Private Sub Class_Initialize()
  7.   Set mcolFoundFiles = New Collection
  8. End Sub

  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

  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

  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

  31. Public Property Get FoundFiles() As Collection
  32.   Set FoundFiles = mcolFoundFiles
  33. End Property

  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

  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    時間: 2014-11-6 20:27

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)