エクセルブック内の決められた文字列の有無を確認するには？

質問

既存ブックを開いて、編集後閉じるときにそのブック内にある文字列が含まれているかを確認する方法はありませんでしょうか？セル内に「氏名」とか「電話番号」とかの文字列が含まれているブックを閉じたときにメッセージを出すアドインを作りたいのです。全セルの値を探すのでは時間がかかってしまうのでそれ以外でいい方法がないかを知りたいのですが・・・

回答No.5

Wendy02

私のはあまり参考にならないかもしれませんね。

＞全てのブックを対象にするのは、結構うっとおしいので、

最初に、xdoc2txt.exe というフリーソフトウェアがあります。
これは、Excelの必要なブックを全てText ファイルに落としてしまうものです。text に落としたものから、検索すると非常に速いです。ブックの開け閉めはしませんからね。
マクロからでも利用できますが、今の所、私の方ではそのコードを公開する予定がありません。

xdoc2txt （フリーソフトウェア）
http://www31.ocn.ne.jp/~h_ishida/xdoc2txt.html

また、KWIC Finder
http://www31.ocn.ne.jp/~h_ishida/KWIC.html
というのは、それをアプリケーションにしたものです。
バイナリ検索は、シェアウェアです。

a269783255様へ。
参考にさせていただきましたが、気を悪くなさらないでくださいね。

'<標準モジュール登録です。>
Option Explicit
Private FindWordsflg As Boolean
Private FindMsg As String
Private Sub FindWords()
Dim SearchWord As Variant
Dim Rng As Range
Dim i As Integer, j As Integer
FindMsg = ""
FindWordsflg = False
SearchWord = Array("住所", "氏名", "電話")
For j = 1 To .Worksheets.Count
　With .Worksheets(j)
　For i = LBound(SearchWord) To UBound(SearchWord)
　 Set Rng = .Cells.Find(What:=SearchWord(i), _
　　　　　　After:=ActiveCell, _
　　　　　　LookIn:=xlValues, LookAt:=xlPart, _
　　　　　　SearchOrder:=xlByRows, _
　　　　　　SearchDirection:=xlNext, _
　　　　　　MatchCase:=False)
　　If Not Rng Is Nothing Then
　　　FindMsg = FindMsg & .Worksheets(j).Name & ": " & SearchWord(i) & Chr(10)
　　　FindWordsflg = True
　　　Set Rng = Nothing
　　End If
　 Next i
　 End With
　 Next j
End Sub

Sub Auto_Close()
Call FindWords
If FindWordsflg = True Then
　　If MsgBox("このブックには、" & Chr(10) & FindMsg & "が含まれています。" & Chr(10) & _
　　　 "終了を止めますか？", 16 + 4) = vbYes Then
　　　Application.ExecuteExcel4Macro "Halt(True)"
　　　Exit Sub
　　Else
　　　ThisWorkbook.Save
　　End If
End If
End Sub

＞「ActiveWorkbook.Save」と記述を追加するだけで済む様にするためです。

ActiveWorkbook　に対するイベントは、一旦、インスタンスを作らないといけないと思います。それで、一番良いのは、Personal.xls になるかと思います。新しく開いたものに、イベントのインスタンスを作ります。

'<Class1モジュール>
Public WithEvents App As Application
Private Sub App_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Call FindWords
If FindWordsflg = True Then
　　If MsgBox("このブックには、" & Chr(10) & FindMsg & "が含まれています。" & Chr(10) & _
　　　 "終了を止めますか？", 16 + 4) = vbYes Then
　　　'Application.ExecuteExcel4Macro "Halt(True)"
　　　Cancel = True
　　　Exit Sub
　　Else
　　　Wb.Close True
　　End If
End If
End Sub

'<標準モジュール>　'一番上に登録
Public FindWordsflg As Boolean
Public FindMsg As String
Public myClass As Class1
Private FindWordsflg As Boolean
' -略 -
End Sub

Sub Auto_Open()
Set myClass = New Class1
Set myClass.App = Application
End Sub

お礼

ツールの紹介までいただきありがとうございます。とても有用なツールですね。実はこういうものも探しておりましたので、利用させていただこうと思います。ところでWendy02様の書いたコードを試す場合は、
アドインとするプロシージャとして
Sub FindWords()、Sub Auto_Close()
を標準モジュール上に記述し、
Personal.xls 上のクラスモジュール上に
Sub App_WorkbookBeforeClose(ByVal Wb As Workbook Cancel As Boolean)
標準モジュール上に
Sub Auto_Open()、Sub FindWords()
を記述するということでよろしいのでしょうか？
まだまだ初心者でWendy02様の内容を全て理解しきれていなく申し訳ありませんが、お教えいただければ幸いです。