Extracting keywords from a string (memo field)

[Mike Faulkner]

Hi.
I want to extract every keyword word, >= 5 characters, from a Memo Field.
Typically a string ["Error in Templates crashes Word every day"] would return
keywords [Error, Templates, crashes, every]. I can then count the number of
times keywords have been entered each day to watch any developing trend.

A VBA solution would be great

Regards
Mike

 

[Ofer]

Using query you can try and write in the criteria for the Memo field

Like "*Error*" Or Like "*Templates*" Or Like "*crashes*" Or Like "*every*"

In SQL View
Select * From TableName Where
[MemoFieldName] Like "*Error*" Or [MemoFieldName] Like "*Templates*" Or
[MemoFieldName] Like "*crashes*" Or [MemoFieldName] Like "*every*"

 

[Ken Sheridan]

Mike:

Try the following. It allows you to pass the desired minimum word length
into the function, so in your case you'd call it with:

GetLongWords(YourMemoField, 5)

I've included as many punctuation characters in the TrimWord function as I
can think of off the top of my head, but if you think of any more just add
them to the Case list. If you want to restrict the words returned to those
which match predefined keywords then create a table Keywords with Column
Keyword and look them up. I've put some code in for this, so just chop that
out if you don't need this.

''''Module starts''''
Option Compare Database
Option Explicit

Function GetLongWords(ByVal strText As String, intWordLength As Integer) As
String

Dim intSpacePos As Integer
Dim strWord As String, strWordList As String

intSpacePos = 0

' replace any double spaces with single space
strText = Replace(strText, " ", " ")

' loop through text and identify each word,
' assuming a word is terminated by a space or end of string
Do While True
intSpacePos = InStr(strText, " ")
If intSpacePos > 0 Then
strWord = Left$(strText, intSpacePos - 1)
' remove any punctuation form end of word
strWord = TrimWord(strWord)
If Len(strWord) >= intWordLength Then
' following <If> and <End If> only necessary if you want to
' look words up in Keywords table
If Not IsNull(strWord, "Keywords" Then
strWordList = strWordList & ", " & strWord
End If
End If
' trim word off text
strText = Mid$(strText, intSpacePos + 1)
Else
' word must be last in text so
strWord = TrimWord(strText)
If Len(strWord) >= intWordLength Then
' following <If> and <End If> only necessary if you want to
' look words up in Keywords table
If Not IsNull(strWord, "Keywords" Then
strWordList = strWordList & ", " & strWord
End If
End If
Exit Do
End If
Loop
' remove leading comma and space
GetLongWords = Mid$(strWordList, 3)

End Function


Private Function TrimWord(strWord As String) As String

' remove any punctuation characters from word
Do While True
Select Case Right$(strWord, 1)
Case ".", ",", ";", ":", "?", "!"
strWord = Left$(strWord, Len(strWord) - 1)
Case Else
Exit Do
End Select
Loop

TrimWord = strWord

End Function
''''Module ends''''

Ken Sheridan
Stafford, England

 

[Mike Faulkner]

Ken

Many thanks it runs well... after dusting off my DAO skills.

Regards
Mike

Mike:

Try the following. It allows you to pass the desired minimum word length
into the function, so in your case you'd call it with:

GetLongWords(YourMemoField, 5)

I've included as many punctuation characters in the TrimWord function as I
can think of off the top of my head, but if you think of any more just add
them to the Case list. If you want to restrict the words returned to those
which match predefined keywords then create a table Keywords with Column
Keyword and look them up. I've put some code in for this, so just chop that
out if you don't need this.

''''Module starts''''
Option Compare Database
Option Explicit

Function GetLongWords(ByVal strText As String, intWordLength As Integer) As
String

Dim intSpacePos As Integer
Dim strWord As String, strWordList As String

intSpacePos = 0

' replace any double spaces with single space
strText = Replace(strText, " ", " ")

' loop through text and identify each word,
' assuming a word is terminated by a space or end of string
Do While True
intSpacePos = InStr(strText, " ")
If intSpacePos > 0 Then
strWord = Left$(strText, intSpacePos - 1)
' remove any punctuation form end of word
strWord = TrimWord(strWord)
If Len(strWord) >= intWordLength Then
' following <If> and <End If> only necessary if you want to
' look words up in Keywords table
If Not IsNull(strWord, "Keywords" Then
strWordList = strWordList & ", " & strWord
End If
End If
' trim word off text
strText = Mid$(strText, intSpacePos + 1)
Else
' word must be last in text so
strWord = TrimWord(strText)
If Len(strWord) >= intWordLength Then
' following <If> and <End If> only necessary if you want to
' look words up in Keywords table
If Not IsNull(strWord, "Keywords" Then
strWordList = strWordList & ", " & strWord
End If
End If
Exit Do
End If
Loop
' remove leading comma and space
GetLongWords = Mid$(strWordList, 3)

End Function


Private Function TrimWord(strWord As String) As String

' remove any punctuation characters from word
Do While True
Select Case Right$(strWord, 1)
Case ".", ",", ";", ":", "?", "!"
strWord = Left$(strWord, Len(strWord) - 1)
Case Else
Exit Do
End Select
Loop

TrimWord = strWord

End Function
''''Module ends''''

Ken Sheridan
Stafford, England

Hi.
I want to extract every keyword word, >= 5 characters, from a Memo Field.
Typically a string ["Error in Templates crashes Word every day"] would return
keywords [Error, Templates, crashes, every]. I can then count the number of
times keywords have been entered each day to watch any developing trend.

A VBA solution would be great

Regards
Mike

 

[Raines95]

I know this question is from a few years ago, but I am trying to get the same
results in Access 2007. At first, it seemed like it was stuck in the loop as
Access would just sit there forever. Now when I run it, it returns no
values. I have confirmed that there are words meeting the length I am
looking for. Is there something new in Access 2007 that would require
changes to this code?

Mike:

Try the following. It allows you to pass the desired minimum word length
into the function, so in your case you'd call it with:

GetLongWords(YourMemoField, 5)

I've included as many punctuation characters in the TrimWord function as I
can think of off the top of my head, but if you think of any more just add
them to the Case list. If you want to restrict the words returned to those
which match predefined keywords then create a table Keywords with Column
Keyword and look them up. I've put some code in for this, so just chop that
out if you don't need this.

''''Module starts''''
Option Compare Database
Option Explicit

Function GetLongWords(ByVal strText As String, intWordLength As Integer) As
String

Dim intSpacePos As Integer
Dim strWord As String, strWordList As String

intSpacePos = 0

' replace any double spaces with single space
strText = Replace(strText, " ", " ")

' loop through text and identify each word,
' assuming a word is terminated by a space or end of string
Do While True
intSpacePos = InStr(strText, " ")
If intSpacePos > 0 Then
strWord = Left$(strText, intSpacePos - 1)
' remove any punctuation form end of word
strWord = TrimWord(strWord)
If Len(strWord) >= intWordLength Then
' following <If> and <End If> only necessary if you want to
' look words up in Keywords table
If Not IsNull(strWord, "Keywords" Then
strWordList = strWordList & ", " & strWord
End If
End If
' trim word off text
strText = Mid$(strText, intSpacePos + 1)
Else
' word must be last in text so
strWord = TrimWord(strText)
If Len(strWord) >= intWordLength Then
' following <If> and <End If> only necessary if you want to
' look words up in Keywords table
If Not IsNull(strWord, "Keywords" Then
strWordList = strWordList & ", " & strWord
End If
End If
Exit Do
End If
Loop
' remove leading comma and space
GetLongWords = Mid$(strWordList, 3)

End Function


Private Function TrimWord(strWord As String) As String

' remove any punctuation characters from word
Do While True
Select Case Right$(strWord, 1)
Case ".", ",", ";", ":", "?", "!"
strWord = Left$(strWord, Len(strWord) - 1)
Case Else
Exit Do
End Select
Loop

TrimWord = strWord

End Function
''''Module ends''''

Ken Sheridan
Stafford, England

Hi.
I want to extract every keyword word, >= 5 characters, from a Memo Field.
Typically a string ["Error in Templates crashes Word every day"] would return
keywords [Error, Templates, crashes, every]. I can then count the number of
times keywords have been entered each day to watch any developing trend.

A VBA solution would be great

Regards
Mike