自分用 OFFICE2007以降 VBA FileSearchについて

pocket9 ドキュメント支援ツール
機能一覧 | 設計書仕様書テンプレート PocketDOC | 株式会社イーイノベーション
の「PocketDocPropertyChangeTool」を利用しようとしてFileSearchでエラーが出た。
調べてみると、Application.FileSearchの構文がOFFICE2007以降で使えなくなっているとの事。

FileSearchをScripting.FileSystemObjectのFileSearchに入れ替えれば動くようなので
クラス化している下記のサイト
Office2007以降廃止となった「FileSearch」の代替クラスを作る - xixiixiiixivの勉強日記
を見つけてそのまま置き換えてみた。
※上記ソースコードをVBEでクラスモジュールとして貼付し、FileSearchClassという名前で保存。

PocketDocPropertyChangeTool側の記述を変更していく。

<shtMain>
[Private Sub cmdAction_Click]
　' ファイル検索の開始
'   With Application.FileSearch
    With New FileSearchClass

おまけでBrowseForFolderに初期値表示のフォルダを設定

<shtMain>
[Private Sub cmdAction_Click]
　CreateObject("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", &H1 + &H10, vDefFolder)

上記のvDefFolderの部分の引数はVariant型でないと初期値として反映されず少し詰まった。（ずっとString型で指定していた)

ここまでの修正を実行するとFileSearchClassにFileTypeのプロパティがなくてエラーが発生。

<shtMain>
[Private Sub cmdAction_Click]
.FileType = msoFileTypeAllFiles

消してもいいけど、後で処理を追加してみようと思い、クラスにダミーのFileTypeを追加。

端末毎に参照設定いじるのめんどそうだなと思い
FileSearchClass側の fso関連の変数を全部Objectに変更して
new FileSystemObject してるところを CreateObject("Scripting.FileSystemObject") に置き換えた。
FileTypeはmsoFileTypeが使えればそのまま使うが、下記のようにした。

<FileSearchClass>
Public Enum enumFileType
  msoFileTypeAllFiles = 1
  msoFileTypeBinders = 6
  msoFileTypeCalendarItem = 11
  msoFileTypeContactItem = 12
  msoFileTypeDatabases = 7
  msoFileTypeDataConnectionFiles = 17
  msoFileTypeDesignerFiles = 22
  msoFileTypeDocumentImagingFiles = 20
  msoFileTypeExcelWorkbooks = 4
  msoFileTypeJournalItem = 14
  msoFileTypeMailItem = 10
  msoFileTypeNoteItem = 13
  msoFileTypeOfficeFiles = 2
  msoFileTypeOutlookItems = 9
  msoFileTypePhotoDrawFiles = 16
  msoFileTypePowerPointPresentations = 5
  msoFileTypeProjectFiles = 19
  msoFileTypePublisherFiles = 18
  msoFileTypeTaskItem = 15
  msoFileTypeTemplates = 8
  msoFileTypeVisioFiles = 21
  msoFileTypeWebPages = 23
  msoFileTypeWordDocuments = 3
  msoLastModifiedAnyTime = 7
  msoLastModifiedLastMonth = 5
  msoLastModifiedLastWeek = 3
  msoLastModifiedThisMonth = 6
  msoLastModifiedThisWeek = 4
  msoLastModifiedToday = 2
  msoLastModifiedYesterday = 1
End Enum

FileSearchClass の方に下記を追加

<FileSearchClass>
Public FileType As enumFileType

shtMainも変更

<shtMain>
[Private Sub cmdAction_Click]
' .FileType = msoFileTypeAllFiles     '検索対象ファイルのタイプを設定
  .FileType = enumFileType.msoFileTypeAllFiles

また、ここまでの修正で

<shtMain>
[Private Sub cmdAction_Click]
.FileName = "*.xls;*.doc;"

の複数拡張子指定で、一切一致するファイルを見つけられなかった。
Likeでも書き方次第で判定できそうだが、正規表現でのマッチングに変更した。

FileSerchClassに下記を追加

<FileSearchClass>
'正規表現マッチング
Private Function ExtRegExp(ByVal Target As String, ByVal FileExt As String) As Boolean
  'RegExpオブジェクトの作成
  Dim reg As Object
  Set reg = CreateObject("VBScript.RegExp")
  
  Dim sPtn As String
  
  'パターン作成
  sPtn = Replace(FileExt, " ", "")
  sPtn = Replace(sPtn, "*.", "")
  sPtn = Replace(sPtn, ";", "|")
  sPtn = IIf(sPtn Like "*|", Left(sPtn, Len(sPtn) - 1), sPtn) '末尾条件整理
  sPtn = ".+\.(" & sPtn & ")"                                 '「*.(拡張子1[|拡張子2]...)」に成形
  
  '正規表現の指定
  With reg
      .Pattern = sPtn     'パターンを指定
      .IgnoreCase = True  '大文字と小文字を区別するか(False)、しないか(True)
      .Global = True      '文字列全体を検索するか(True)、しないか(False)
  End With

  ExtRegExp = (reg.Execute(Target).Count > 0)

End Function

Likeで拡張子の判定している箇所をExtRegExpに置換

<FileSearchClass>
[Private Sub runSearch(sArgSearchPath As String)]
' If Not (oFile.Name Like FileName) Then GoTo CONTINUE ' 処理対象外を除外
 If Not ExtRegExp(oFile.Name, FileName) Then GoTo CONTINUE  ' 処理対象外を除外

これで大体動くようになった。