Первый шаг в полнотекстовом поиске - создать список слов, содержащий все слова в базе данных. Полнотекстовый поиск также имеет и другие функции, такие как определение слова, которое связывает производные слова с базовым словом (быстро, быстрее, быстрее) и содержит стоп-слова, которые игнорируются, потому что они так часто встречаются (и). Небольшой код VBA может генерировать список слов, который можно визуально сканировать. Приложив немного больше работы, можно было бы использовать код для проверки списка слов перед поиском в базе данных, и это может сделать поиск намного быстрее. Ниже приведен код, который я создал для этой цели. Его реальное применение состоит в том, чтобы находить имена людей в базе данных, чтобы я мог удалить или изменить их для защиты конфиденциальности, и как биолог, я хочу выделять научные имена в отчетах. Если я смогу создать список научных названий, я смогу заменить их на имена, заключенные в HTML-теги.
Код работает хорошо, но я не проверял его всесторонне или в отношении больших полей memo / полей расширенного текста. Это было написано в Access 2010.
'This code requires a table called tblWordList with fields called Word (str 255), WordCount (long), FirstCopyID (long)
Option Compare Database
Option Explicit
'Click on this procedure and press F5 to run the code
Private Sub ScopeWordList()
'A list of tables and fields that need to be processed
Call CreateWordList("Issues", "IssueSummary", "IssueID")
End Sub
'The main routine that finds new words
Public Sub CreateWordList(TableName As String, FieldName As String, ForeignKey As String)
Dim dbs As Database
Dim rst As Recordset
Dim SQL_Statement As String
Dim r As Recordset
Dim RowText As String
Dim OriginalWord As String
Dim SearchWord As String
Dim SearchTerm As String
Dim Quote As String: Quote = Chr$(34)
Dim i As Long
Dim RecNum As Long
SQL_Statement = "SELECT " & FieldName & ", " & ForeignKey & " AS FirstCopyID FROM " & TableName & " WHERE " & FieldName & " IS NOT NULL;"
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset(SQL_Statement, dbOpenSnapshot)
Set r = dbs.OpenRecordset("tblWordCounts", dbOpenTable)
r.Index = "Word"
With rst
If .RecordCount = 0 Then GoTo ExitCreateWordList
Do Until .EOF
Dim RowWords As Variant 'holds an array which needs to be created
RowText = .Fields(0)
'strip out quotes, slashes and other characters
RowText = CleanLine(RowText)
'split data into words
RowWords = Split(RowText, Space(1))
For i = LBound(RowWords) To UBound(RowWords)
OriginalWord = RowWords(i)
SearchWord = Left(Trim(OriginalWord), 254)
If Len(SearchWord) > 0 Then
r.Seek "=", SearchWord
If r.NoMatch Then
r.AddNew
r!Word = SearchWord
r!wordcount = 1
'records ID field of first occurrence, so you can debug unexpected results
r!FirstCopyID = !FirstCopyID
r.Update
Else
r.Edit
r!wordcount = r!wordcount + 1
r.Update
End If
End If
' End If
Next i
RecNum = RecNum + 1
If RecNum Mod 20 = 0 Then Debug.Print "Record " & RecNum
.MoveNext
Loop
ExitCreateWordList:
End With
Debug.Print "Done"
Set rst = Nothing
Set dbs = Nothing
End Sub
'Need to clean out unwanted characters and replace then with normal spaces
Private Function CleanLine(RowText As String) As String
Dim X As Long
Dim Y As String
Dim Z As Long
Dim W As String
For X = 1 To Len(RowText)
Y = Mid(RowText, X, 1)
Z = Asc(Y)
Select Case Z
Case 65 To 90 'capital letters
W = W & Y
Case 97 To 122 'lowercase letters
W = W & Y
Case Else
W = W & Space(1)
End Select
Next
CleanLine = W
End Function
'Delete all records in Word List table
Public Sub ClearWordList()
Dim SQL_Statement As String
'Delete all records from tblWordCounts
SQL_Statement = "DELETE FROM tblWordCounts"
DoCmd.SetWarnings False
DoCmd.RunSQL SQL_Statement
DoCmd.SetWarnings True
End Sub