Create a list box of synonyms from word.application?

[AdamOnAccess]

Is there a way to use word.application 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.application, 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]

@AdamOnAccess
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]

@msquared
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]

@AdamOnAccess
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]

@NeoPa
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:=wdEnglishUS).SynonymList(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 pfnRenumberArray(astrSynonyms) as well.

[NeoPa]

Adam,

FYI.There are two main things to look out for in a situation like this (ADezii knows already) :

1. All objects must be properly closed and released in the code.
2. The structure or flow of the code, is such that it works as efficiently as possible. Sometimes it's quite possible to reuse an object. It's often easier to create new objects for each task though. This is rarely an issue with straight-through programming, but anything repetitive or recursive multiplies this effect so that it can be a problem.

Anyway, I'm sure ADezii will be able to find (& fix) it for you.

[AdamOnAccess]

ADezii,

I'll put together a database that contains all the relevent stuff. It is currently in Access 2007. Is that version OK, or do you need something earlier?

NeoPa,
Thanks for the input. Yes, I suspect I am not closing or releasing something, or perhaps I am creating multiple instances.

Or perhaps my machine has issues. Either way, I'll get a version uploaded and let you guys take a whack at it.

Thanks,
Adam

[ADezii]

I'll put together a database that contains all the relevent stuff. It is currently in Access 2007. Is that version OK, or do you need something earlier?

For the time being, I'll need it in an Access 2002 Version.

[NeoPa]

Adam,

I knocked something up before as a guide to attaching databases. I hope it helps.

When attaching your work please follow the following steps first :

1. Remove anything not relevant to the problem. This is not necessary in all circumstances but some databases can be very bulky and some things do not effect the actual problem at all.
2. Likewise, not entirely necessary in all cases, but consider saving your database in a version not later than 2003 as many of our experts don't use Access 2007. Largely they don't want to, but some also don't have access to it. Personally I will wait until I'm forced to before using it.
3. If the process depends on any linked tables then make local copies in your database to replace the linked tables.
4. If you've done anything in steps 1 to 3 then make sure that the problem you're experiencing is still evident in the updated version.
5. Compile the database (From the Visual Basic Editor select Debug / Compile {Project Name}).
6. Compact the database.
7. Compress the database into a ZIP file.
8. When posting, scroll down the page and select Manage Attachments (Pressing on that leads you to a page where you can add or remove your attachments. It also lists the maximum file sizes for each of the allowed file types.) and add this new ZIP file.

It's also a good idea to include some instructions that enable us to find the issue you'd like help with. Maybe some instructions of what to select, click on, enter etc that ensures we'll see what you see and have the same problems.

[AdamOnAccess]

ADezii,

Ok, attached is an access 2002 version of a database containing the code we've been discussing. I've narrowed it down to only the relevent parts. Please don't think I'm being cagey about my code; I have no doubt you can write circles around any code I've ever written, but there are a few other bugs I have to work out and I didn't want them muddying the waters. I'd be happy to show you the entire project if you find it interesting - just let me know.

NeoPa, same goes for you too.

I have tested the code in this 2002 version and I have it working exactly as it works in the 2007 version. I've added plenty of comments.

Again, the objective is to take a phrase like "Beer Making Kit", and return a list of synonyms phrases like "Beer Manufacturing Equipment", "Beer Producing Gear", etc.

To run it, just open the only form in the database, enter a phrase like "Beer Making Kit", and hit the button. After a few moments, the list box should fill up with phrases.

Right now, it works nearly perfectly, except that after it runs a few times I begin to get warnings that virtual memory is tapping out.

Good luck with it and try not to laugh at my coding too much :)
Thanks,
-Adam

[ADezii]

Got it, give me a couple of days to go over the code.

[ADezii]

Before you do anything else, try to reclaim the Memory used by the Arrays in each Procedure, as in:

Private Sub cmdGetLikePhrases_Click()
 ...'ALL previous code intentionally omitted
 
'Reclaim/Free the Memory used by the Arrays
Erase astrSynonyms
Erase astrNewList
Erase astrMultiSynonyms
End Sub

[AdamOnAccess]

Ok. I'll run a few tests and see how that goes.
Thanks,
-Adam

[AdamOnAccess]

ADezii,

Chalk up another victory for you!

The virtual memory problem is gone. After some minor debugging, the program performs perfectly.

Just out of curiousity, how long does it take to become an Access phenom like you?

Thanks again,
-Adam

[ADezii]

Just a self taught home boy!

[alphanj]

Dear all,
Is there any possibility to add a new synonyms list to MS-word or customize it?

I have a list of synonyms which is not already in the list.

[ADezii]

@alphanj
Hello alphani. This was quite a challenge, since I do believe that you cannot modify the intrinsic Synonym List in Microsoft Work for any given word(s). I did, however, create a Custom Function which will supplement Word's Synonym List for a specific word. Pass to the Function the word for which you want to generate Synonyms, as well as an Optional, Comma-Delimiter String consisting of additional Synonyms for the given word separated by Comma(s). Enough already, I post the code along with sample usage. Any questions, feel free to ask.

1. Standard Synonym List for 'Devil' and results via Function Call:
   

   ? fReturnSynonyms("Devil")

   Synonyms for Devil
   ---------------------------
   fiend
   evil spirit
   imp
   mischievous sprite
   sprite

2. Let's add NeoPa and ADezii as additional Synonyms for 'Devil':
   

   ? fReturnSynonyms("Devil","NeoPa,ADezii")

   Synonyms for Devil
   ---------------------------
   fiend
   evil spirit
   imp
   mischievous sprite
   sprite
   NeoPa
   ADezii

3. Code that makes this all happen:
   

   Public Function fReturnSynonyms(strWord As String, Optional strMoreArgs As String = "")
   On Error GoTo Err_fReturnSynonyms
   Dim aList As Variant
   Dim intCounter As Integer
   Dim varRet As Variant
   Dim intCounter_2 As Integer
    
   Dim wd As Word.Application
    
   Set wd = New Word.Application
    
   aList = wd.SynonymInfo(Word:=strWord, LanguageID:=wdEnglishUS).SynonymList(Meaning:=1)
    
   Debug.Print "Synonyms for " & strWord
   Debug.Print "---------------------------"
    
   If strMoreArgs <> "" Then
     varRet = Split(strMoreArgs, ",")
       For intCounter = LBound(varRet) To UBound(varRet)
         'MsgBox varRet(intCounter)
         ReDim Preserve aList(UBound(aList) + 1)
         aList(UBound(aList) - 1) = varRet(intCounter)
       Next
   End If
    
   If UBound(aList) <> 0 Then
     For intCounter_2 = LBound(aList) To UBound(aList)
     'For intCounter_2 = 0 To UBound(aList) - 1
       Debug.Print aList(intCounter_2)
     Next
   End If
    
   Set wd = Nothing
    
   Erase aList
    
   Exit_fReturnSynonyms:
     Exit Function
    
   Err_fReturnSynonyms:
     If Err.Number = 5843 Then
       MsgBox "No Synonyms found for " & strWord, vbExclamation, "No Synonyms Found"
     Else
       MsgBox Err.Description, vbExclamation, "Error in fReturnSynonyms()"
     End If
       Resume Exit_fReturnSynonyms
   End Function
    
    

4. P.S. - Modifications were made to the original Code Template.