Office2007的Application.filesearch替代方法

  • Posted on
  • by

前一段时间,各大公司竞相裁员。微软也没有例外。但是微软出了一个差错,先是多给了被辞退员工补贴金,接着又威胁人家交还差额。后来传出了一个段子,说是因为微软的excel产品本身的bug导致了这个错误。我想提出这种说法的人一定对微软是深恶痛绝的吧。

最近升级到了office2007以后,让我相信这种说法可能还真的不是空穴来风。对于习惯了2003的人来说,office2007界面变得很花哨,可实际上并没有什么很特别的新功能。而一些原来office2003支持的功能被取消了,比如powerpoint的录制宏的功能取消了,ppt模板默认设置变了,一些对象和属性被取消了,比如FileSearch。如果是基于office2003开发的工具,用office2007打开以后,没有意外就会出现了一堆的debug窗口。到网上论坛看看,你就可以发现受到影响的人有多少。当你咬牙用了几天把原来的工具移植到office2007以后,你会发现程序根本跑不动,因为office2007实在是太臃肿了。

目前看来,如果想让老的macro在新的程序上能够跑起来,对于比较少用的功能,可以用替代的方法。对于在代码中重复用到的功能,可以新建类,这对代码的改动小一些。比如FileSearch。

这个从2006年一直到2009年都有人回应的帖子可见office产品在用户当中有多普及。整个帖子看下来,用自定义的类代替被取消的filesearch功能是比较可行的。

第一个类,命名为FileSearh:

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 :

Public FoundFileFullName As String

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

使用:

Dim sFile as String
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

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