【VBA】フォルダ内全てのWordファイルの文字列検索して、個数を出力する

文字を入力した後に入力確認することは正確性を保つために大丈夫なことである。少ないときはプル一フリストのような入力内容の目視確認でよいが、フォルダ内のWordファイルファイル全てとなると面倒になる。そのため、入力内容の確認の一貫として、ExcelVBAでフォルダ内全てのWordファイルの文字列の検索個数について出力して、個数を調べるマクロを作成したので情報共有を行う。

STEP1:プログラムの概要

プログラムの含まれているWordファイルは以下のものを前提とする。

Wordファイルに含まれている表の内容を入力してボタンを押すと、上記の図の下部分ように検索したフォルダ内に含まれていた場合には該当ファイル名と含まれている個数を出力する。

STEP2:使用関数

〇Wordファイル内の文字列検索について

【Word VBA】選択したキーワードの個数を数える（その2）

先日、翻訳者仲間とお茶をしていたときに、私が以前紹介した記事「【Wordマクロ】選択した文字列の出現頻度を数える」のマクロを使っているとうれしい話を聞きました。 3年以上前のマクロです。見直してみた

https://www.wordvbalab.com/code/462/

〇Word内のカ－ソル移動について

Word VBAでカーソル移動をする基本中の基本！Moveメソッドの使い方

カーソル移動は全く生産性がないくせに、うっかりしていると何気に手間がかかってしまいます。まず今回は、Word VBAのカーソル移動の基本中の基本、Moveメソッドの使い方についてお伝えします。

https://tonari-it.com/word-vba-move-cursor/

※以下、広告リンクです

STEP3 ソースコード

Sub Serch_word_str_count()
'----------------------------------------------
'概要: 指定したフォルダ内のWordファイル内に指定した文字列が含まれている個数を確認する
'機能名: Serch_word_str_count
'引数: なし
'戻り値: なし
'備考1:<https://www.wordvbalab.com/code/462/をモデルに作成>
'----------------------------------------------
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim rng As Object
    Dim count_str As Integer
    Dim inputword As String
    Dim myPath As String
    Dim kakutyoshi As String
    Dim myDocuments_name As String
    Dim myText As String

    'B2のセルに入力したパスを登録する
    myPath = ThisWorkbook.Worksheets(1).Cells(2, 2).Value & "\\"
    If ThisWorkbook.Worksheets(1).Cells(3, 2).Value = "" Then
    'B3のセルが空白であれば、デフォルトでdocxを対象にする
    kakutyoshi = "docx"
    Else
    'B3のセルが入力されていたら、入力した拡張子を登録する
    kakutyoshi = ThisWorkbook.Worksheets(1).Cells(3, 2).Value
    End If
    'B4のセルに入力した検索単語を登録する
    inputword = ThisWorkbook.Worksheets(1).Cells(4, 2).Value
    
    'ファイルシステムのオブジェクトにアクセスする
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Dim objFolder As Object
    Set objFolder = objFso.GetFolder(myPath)
    ' Word アプリケーションを開始
    Set wdApp = CreateObject("Word.Application")
    '正規表現のオブジェクトを設定
    Set myRE = CreateObject("VBScript.RegExp")
    book_number = 1
    'Dir関数がファイル名を返さなくなるまで繰り返す
    For Each f In objFolder.Files
    If Instr (f.name, kakutyoshi)>0 Then
        ' Word 文書を開く
        Set wdDoc = wdApp.Documents.Open(ReadOnly:=True, Filename:=myPath & f.Name)
        myText = wdDoc.Range.Text
        'キーワードの数を数える
        With myRE
            .Pattern = inputword '検索する文字列
            .IgnoreCase = True '大文字と小文字を区別しない
            .Global = True '文字列全体を検索
            Set myMatch = .Execute(myText)
            count_str = myMatch.Count
        End With
        ' 検索処理        
        'Msgbox "「詳細」の個数：" & count_str
        '1列目のセルにファイル名を書き込み
        ThisWorkbook.Worksheets(1).Cells(book_number + 10, 1).Value = f.Name
        '2列目のセルにページ数を書き込み
        ThisWorkbook.Worksheets(1).Cells(book_number + 10, 2).Value = count_str
        'book番号を1増やす
        book_number = book_number + 1
        count_str = 0
        
        ' Word を閉じる
        wdDoc.Close
        End If
    Next f
End Sub