Create a list box of synonyms from word.application?

[AdamOnAccess]

Is there a way to use word.applicatio n to pull synonyms from the word thesaurus and have them appear in a list box? I know how to bring up the thesaurus box using word.applicatio n, but I don't know how to extract that data to appear in Access. I've searched the web on this topic and found surprisingly little about it.

If this isn't possible, I'd be interested in knowing any other methods of integrating a thesaurus into an Access 2007 database.

Thanks,
Adam

[ADezii]

1. The following Sub-Routine, using Automation with Microsoft Word, will generate a list of Synonyms for the Word passed to it:
   

   Public Sub ReturnSynonyms(strWord As String)
   Dim aList As Variant
   Dim intCounter As Integer
   
   Dim wd As Word.Application
   
   Set wd = New Word.Application
   
   Debug.Print "Synonyms for " & strWord
   Debug.Print "---------------------------"
   
   aList = wd.SynonymInfo(Word:=strWord, LanguageID:=wdEnglishUS).SynonymList(Meaning:=1)
   
   If UBound(aList) <> 0 Then
     For intCounter = 1 To UBound(aList)
       Debug.Print aList(intCounter)
     Next
   Else
     MsgBox "No Synonyms found for " & strWord, vbExclamation, "No Synonyms Found"
   End If
   
   Set wd = Nothing
   End Sub

2. Sample Call to Routine:
   

   Call ReturnSynonyms("old")

3. Sample OUTPUT:
   

   Synonyms for old
   ---------------------------
   aged
   elderly
   older
   mature
   getting on
   not getting any younger

[AdamOnAccess]

ADezii - That's positively outstanding! I'll test it out today.
Thanks,
Adam

[ADezii]

ADezii - That's positively outstanding! I'll test it out today.
Thanks,
Adam

I've intentionally made the call very flexible in that there are a variety of Methods to return the Synonyms, e.g. populate a List Box, Function returning an Array, on a single line delimited by a comma, etc.

P.S. - You can also return Antonyms.

[MMcCarthy]

That's the words for our ADezii, "positively outstanding". We've very lucky to have him :)

Mary

[ADezii]

That's the words for our ADezii, "positively outstanding". We've very lucky to have him :)

Mary

Thanks Mary for the kind words, but I feel very honored just being a part of this elite group and excellent Forum. I've learned just as much as I have taught.

[NeoPa]

ADezii - That's positively outstanding!

Adam - That's positively typical!

Great work again ADezii :)

Just a quick question though :
Is there any reason why you start at 1 on line #15 of your code. I would expect LBound(aList) to resolve to 0 generally.

[ADezii]

Adam - That's positively typical!

Great work again ADezii :)

Just a quick question though :
Is there any reason why you start at 1 on line #15 of your code. I would expect LBound(aList) to resolve to 0 generally.

The SynonymList Property of the SynonymInfo Object returns a Variant Array of Strings that apparently is 1-based as evidenced by the modified code below which used LBound() instead of 1 and still produces the same results (LBound(aList) resolves to 1).

'Relevant code only has been posted
aList = wd.SynonymInfo(Word:=strWord, LanguageID:=wdEnglishUS).SynonymList(Meaning:=1)
  
If UBound(aList) <> 0 Then
  For intCounter = LBound(aList) To UBound(aList)
    Debug.Print aList(intCounter)
  Next
Else
  MsgBox "No Synonyms found for " & strWord, vbExclamation, "No Synonyms Found"
End If

P.S. - Thanks for the kind words.

[NeoPa]

Oh. That's cool then :)

[AdamOnAccess]

Hi ADezii,

I've been working with the code you posted and for the most part, it works great. I have run across one issue that I can't seem to fix. Here is the function I'm using:

Public Function pfnGetSynonyms(strWord As String) As Variant
'Returns an array of Synonyms words
'Requires refererence to Microsoft Word 10.0 Object Library

   Dim astrSynonyms As Variant
    
   Dim wd As Word.Application
  
   Set wd = New Word.Application

   astrSynonyms = wd.SynonymInfo(Word:=strWord, LanguageID:=wdEnglishUS).SynonymList(Meaning:=1)
   
   If LBound(astrSynonyms) <> 0 Then
      pfnGetSynonyms = pfnRenumberArray(astrSynonyms)
   Else
      pfnGetSynonyms = astrSynonyms
   End If
   
   Set wd = Nothing
   
End Function

Recently, I sent the word "brewery" to the function and it errored:

Run-Time Error 5843
One of the values passed to this method or property is out of range.

Error occured on this line:
astrSynonyms = wd.SynonymInfo( Word:=strWord, LanguageID:=wdE nglishUS).Synon ymList(Meaning: =1)

I went into MS Word and ran the thesaurus on "brewery" and it came back with no suggestions. I also tested the work "brewing". It also failed and MS Word thesaurus also had no suggestions.

So it appears that, when you submit a word and the thesaurus can't offer any suggestions, the above line in the code errors before it reaches the test to see if the returned array is empty.

Would you know how to fix that?
Thanks,
Adam

[ADezii]

You can set a 'Trap' for that specific Error (5843), then display a descriptive Message Box indicating to the User that no Matches were found:

Public Function pfnGetSynonyms(strWord As String) As Variant
On Error GoTo Err_pfnGetSynonyms
'Returns an array of Synonyms words
'Requires refererence to Microsoft Word 10.0 Object Library
Dim astrSynonyms As Variant
Dim wd As Word.Application
  
Set wd = New Word.Application
  
astrSynonyms = wd.SynonymInfo(Word:=strWord, LanguageID:=wdEnglishUS).SynonymList(Meaning:=1)
  
If LBound(astrSynonyms) <> 0 Then
  pfnGetSynonyms = pfnRenumberArray(astrSynonyms)
Else
  pfnGetSynonyms = astrSynonyms
End If
  
Set wd = Nothing

Exit_pfnGetSynonyms:
  Exit Function

Err_pfnGetSynonyms:
  If Err.Number = 5843 Then
    MsgBox "No Synonyms were found for [" & strWord & "]", vbExclamation, _
    "No Matches Found"
  Else
    MsgBox Err.Description, vbExclamation, "Error in pfnGetSynonyms()"
  End If
    Resume Exit_pfnGetSynonyms
End Function

P.S. - Take a specific look at Code Lines: 2, 20 - 21, and 23 - 30.

[AdamOnAccess]

Neat! Thanks ADezii!

[ADezii]

You are quite welcome.

[AdamOnAccess]

Hi again ADezii,

I hope you don't mind me hitting you up again about this piece of code, but frankly, I think it is the coolest thing. It's very useful for my application.

I've set up a text box where a user can enter a phrase. I use the split function to break that phrase into individual words, then I run each word through the thesauraus. I then take each list from the thesaurus and combine them to form lists of synonoums phrases.

It's working great except for one issue: I am running out of virtual memory after I use it a few times. After a few runs, I have to reboot. Is there anything I can do to fix this?

Thanks,
Adam

[ADezii]

1. Kindly post all relevant code that you have not already posted, or better yet, Upload a Test Version of the Database.
2. If you are not going to Upload the Database, I'll need to see the code behind pfnRenumberArra y(astrSynonyms) as well.