「MDB(Accessデータベース)ファイルを作成してデータを格納するExcelマクロ」で辞書データを格納したMDBファイルを作成しました。
折角なのでこのファイルを利用したWordマクロを考えてみます。
Option Explicit Public Sub AddCommentFromMDB() Dim DBFilePath As String Dim con As String Dim cn As Object Const TableName As String = "tblDic" 'テーブル名 Const FieldName1 As String = "word" 'フィールド名1 Const FieldName2 As String = "meaning" 'フィールド名2 DBFilePath = ThisDocument.Path & Application.PathSeparator & "MyDB.mdb" If Len(Dir(DBFilePath)) < 1 Then MsgBox "MDBファイルが見つかりませんでした。" & vbCrLf & "処理を中止します。", vbExclamation + vbSystemModal Exit Sub End If con = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFilePath Set cn = CreateObject("ADODB.Connection") cn.Open con With CreateObject("ADODB.Recordset") '.Open TableName, cn, 1, 1 .Open "SELECT * FROM " & TableName & " WHERE " & FieldName1 & " LIKE 'a%'", cn, 1, 1 '"a"から始まる単語のみ処理 If .RecordCount <> 0 Then .MoveFirst Do Until .EOF FindProc .Fields(FieldName1).Value, .Fields(FieldName2).Value .MoveNext DoEvents Loop End If .Close End With cn.Close Set cn = Nothing MsgBox "処理が終了しました。", vbInformation + vbSystemModal End Sub Private Sub FindProc(ByVal txt1 As String, ByVal txt2 As String) Dim r As Word.Range Set r = ActiveDocument.Range(0, 0) With r.Find '検索条件は適宜変更 .ClearFormatting .ClearAllFuzzyOptions .Text = txt1 .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = True .MatchWholeWord = True .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = False Do While .Execute r.Comments.Add r, txt2 'コメント追加 Loop End With Set r = Nothing End Sub
上記マクロを実行すると、MDBファイルから読み込んだ単語を元にWord文書内を検索し、ヒットした場合はMDBファイルから読み込んだ単語の意味をコメントにする処理を行います。
(全レコードを処理すると件数が多いので、上記コードではWHERE句で処理する単語を制限しています。)
今回は簡単にテストしただけなので検索精度を考慮していません。
より正確に処理する場合は、検索条件やMDBに格納するデータ内容を変更する必要があります。
この記事へのコメントはありません。