在office 2007中增加FileSearch对象[2009.05.23更新]

mfkiass

支持支持

zhangyong

感谢三戒高手提供的好东西，我在国外的好多Excel论坛上都有人抱怨这个问题，我试了很多他们提供的代码，这个是比较经典的一个。转过来大家一起享受！

Excel
VBA
Application.FileSearch
2003
2007

'!!!! Replacement solution including searching in subdirectories !!!


//------------------------------------------------------------------------------------------------

Sub FileSearchByHavrda_Example_of_procedure_calling()
'
' Example of FileSearchByHavrda procedure calling as replacement of missing FileSearch function in the newest MS Office VBA
' 01.06.2009, Author: P. Havrda, Czech Republic
'

Dim FileNameWithPath As Variant
Dim ListOfFilenamesWithParh As New Collection    ' create a collection of filenames

' Filling a collection of filenames (search Excel files including subdirectories)
Call FileSearchByHavrda(ListOfFilenamesWithParh, "C:\Temp", "*.xls", True)

' Print list to immediate debug window and as a message window
For Each FileNameWithPath In ListOfFilenamesWithParh    ' cycle for list(collection) processing
        Debug.Print FileNameWithPath & Chr(13)
        MsgBox FileNameWithPath & Chr(13)
Next FileNameWithPath

' Print to immediate debug window and message if no file was found
If ListOfFilenamesWithParh.Count = 0 Then
    Debug.Print "No file was found !"
    MsgBox "No file was found !"
End If

End Sub

//------------------------------------------------------------------------------------------------

Private Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As String, pMask As String, pIncludeSubdirectories As Boolean)
'
' Search files in Path and create FoundFiles list(collection) of file names(path included) accordant with Mask (search in subdirectories if enabled)
' 01.06.2009, Author: P. Havrda, Czech Republic
'

Dim DirFile As String
Dim CollectionItem As Variant
Dim SubDirCollection As New Collection

' Add backslash at the end of path if not present
pPath = Trim(pPath)
If Right(pPath, 1) <> "\" Then pPath = pPath & "\"

' Searching files accordant with mask
DirFile = Dir(pPath & pMask)
Do While DirFile <> ""
pFoundFiles.Add pPath & DirFile  'add file name to list(collection)
DirFile = Dir ' next file
Loop

' Procedure exiting if searching in subdirectories isn't enabled
If Not pIncludeSubdirectories Then Exit Sub

' Searching for subdirectories in path
DirFile = Dir(pPath & "*", vbDirectory)
Do While DirFile <> ""
    ' Add subdirectory to local list(collection) of subdirectories in path
    If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath & DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath & DirFile
    DirFile = Dir 'next file
Loop

' Subdirectories list(collection) processing
For Each CollectionItem In SubDirCollection
     Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask, pIncludeSubdirectories) ' Recursive procedure call
Next

End Sub

//------------------------------------------------------------------------------------------------

boatwxp

正为这个烦恼呢，已下载附件，测试一下！

绿色沙漠风暴

顶一下，三戒老师你的课讲的很生动，受教了，我看了一下你的论坛人气很旺呀，恭喜呀！
多发表一些精典内容哦。祝你越来越旺，加油！

steven064

在2003中使用：我的为什么提示“程序目录下没有FileSearch.dll文件，无法使用该功能”？
在2007中打开文件一点反应也没有

[ 本帖最后由 steven064 于 2010-5-4 14:36 编辑 ]

赵文竹

老师，对于这个插件我还没有进行尝试，因为现在正处于初级阶段，所以先收藏等随便再使用。但现在有一个小问题想问一下：
培训中在批量打印文件时，我把你的代码进行了再编写，但一直出现错误（我已认真检查，代码好象应该没错呀！）： 提示，为什么会出现保存提示呢？savechanges:=False 不是就是不进行保存的设置吗？请指导！谢谢！！

Plum125

三戒老师好，听了您的课程，感觉您非常认真的在讲授。来到这里看到这些作品，虽然看不懂，可踏实谨慎的精神太值得我学习了。

tina136

支持老师~~

youliqi

收藏、好好学习学习
谢谢楼主

lixstar

高手！路过！看看！！！