pocket9 ドキュメント支援ツール
機能一覧 | 設計書仕様書テンプレート PocketDOC | 株式会社イーイノベーション
の「PocketDocPropertyChangeTool」を利用しようとしてFileSearchでエラーが出た。
調べてみると、Application.FileSearchの構文がOFFICE2007以降で使えなくなっているとの事。
FileSearchをScripting.FileSystemObjectのFileSearchに入れ替えれば動くようなので
クラス化している下記のサイト
Office2007以降廃止となった「FileSearch」の代替クラスを作る - xixiixiiixivの勉強日記
を見つけてそのまま置き換えてみた。
※上記ソースコードをVBEでクラスモジュールとして貼付し、FileSearchClassという名前で保存。
PocketDocPropertyChangeTool側の記述を変更していく。
<shtMain>
[Private Sub cmdAction_Click]
' ファイル検索の開始
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 = 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
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 & ")"
With reg
.Pattern = sPtn
.IgnoreCase = True
.Global = True
End With
ExtRegExp = (reg.Execute(Target).Count > 0)
End Function
Likeで拡張子の判定している箇所をExtRegExpに置換
<FileSearchClass>
[Private Sub runSearch(sArgSearchPath As String)]
If Not ExtRegExp(oFile.Name, FileName) Then GoTo CONTINUE
これで大体動くようになった。