Office2007及2010版本FileSearch方法被阉割的取代方法

今天早上有个网友加我QQ让我帮他弄个VBA，A列为文本文件名，B列为对应的文件内容。把以前用的批量获取指定目录下的文件名宏拿出来用，可在我的Excel2010上没反应，换台装2003的正常运行，于是进行调试，发现了Application.FileSearch这句对象不支持。打开对象浏览器，居然找不到Filesearch方法，再打开“显示隐含成员”时发现“Filesearch“变成灰色的了，原来成太监了。以前很多用2003做的宏，用office2007打开以后，总是会出现了一堆的窗口。在网上找到一个替代方法：对于在代码中重复用到的功能，可以新建类，这对代码的改动小一些。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

Dim pLookIn As String Dim pSearchSubFolders As Boolean Dim pFileName As String
Public FoundFiles As New Collection
Public Property Get LookIn() As String
LookIn = pLookIn
End Property
Public Property Let LookIn(value As String)
pLookIn = value
End Property
Public Property Get SearchSubFolders() As Boolean
LookIn = pSearchSubFolders
End Property
Public Property Let SearchSubFolders(value As Boolean)
pSearchSubFolders = value
End Property
Public Property Get fileName() As String
fileName = pFileName
End Property
Public Property Let fileName(value As String)
pFileName = value
End Property
Public Function Execute() As Long

Dim ex As Long
Dim sLookIn As String
Dim sDirName As String
Dim sSubDir As String
Dim sFileName As String
Dim ff As FilesFound

Set ff = New FilesFound
sLookIn = LookIn
sDirName = Dir(sLookIn, vbDirectory)
sFileName = Dir(sLookIn & "\", vbNormal)
Do Until Len(sFileName) = 0
If sFileName Like fileName Then
ff.AddFile sLookIn, sFileName
FoundFiles.Add (ff.FoundFileFullName)
End If
sFileName = Dir
Loop
If SearchSubFolders Then
Do Until Len(sDirName) = 0
If GetAttr(sLookIn & sDirName) = vbDirectory Then
sSubDir = sDirName
Do Until Len(sFileName) = 0
If GetAttr(sDirName) = vbNormal Then
sFileName = sDirName
ff.AddFile sDirName, sFileName
FoundFiles.Add (ff)
End If
Loop
End If
sDirName = Dir
Loop
End If
Execute = FoundFiles.Count
End Function

第二个类，命名为FilesFound ：

1
2
3
4

Public FoundFileFullName As String
Public Function AddFile(path As String, fileName As String)
FoundFileFullName = path & "\" & fileName
End Function

使用：

1
2
3
4
5
6
7
8
9
10
11
12

Dim fs As New FileSearh
With fs
.LookIn = sPath
.SearchSubFolders = True
.fileName = "*"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
sFile = .FoundFiles(i)
' your code here
Next
End If
End With

这种办法虽然相当原来的功能有一些少，但是可以一定程度上减少代码移植的成本。

本站声明:网站内容来源于网络,如有侵权,请联系我们,我们将及时处理。

本博客所有文章如无特别注明均为原创。
复制或转载请以超链接形式注明转自起风了，原文地址《Office2007及2010版本FileSearch方法被阉割的取代方法》