「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に格納するデータ内容を変更する必要があります。




















この記事へのコメントはありません。