Thesarus

[Nedan Nedzatra]

Hia!

How are you doing friends?

Some help please!!!

I type 'Some' into A1; Then I select Thesarus to see a list of similar
words; I like to get them into an array.

Is it possible at all?

 

[Peter T]

Following gets 'some' results but nothing like the extensive list returned
with Shift F7 in Word. Maybe there's a different way!

Option Explicit
Private mObjWord As Object

Sub test()
Dim i As Long
Dim sWord As String
Dim arr

sWord = "some"

If GetMeanings(sWord, arr) Then
For i = LBound(arr) To UBound(arr)
Debug.Print arr(i)
Next

End If

' call AllDone ' when done

End Sub

Sub AllDone()
Set mObjWord = Nothing
End Sub

Function GetMeanings(myWord As String, vMeanings)
Dim objSynonymInfo As Object

If mObjWord Is Nothing Then
Set mObjWord = CreateObject("word.application")
End If

Set objSynonymInfo = mObjWord.SynonymInfo(myWord)

vMeanings = objSynonymInfo.MeaningList

GetMeanings = UBound(vMeanings) > 0

Exit Function
errExit:

End Function


Don't forget to clean up the Word object when done

Regards,
Peter T

 

[Peter T]

Can indeed get more info -
Add the Word reference (Tools References, Microsoft Word)

change

Dim objSynonymInfo As Object

to
Dim objSynonymInfo As Word.SynonymInfo

Select "SynonymInfo" and press F1 to get Word VBA help. Look at the examples
with
..MeaningList .PartOfSpeechList .RelatedWordList .RelatedExpressionList

Note too the language option with SynonymInfo

If you want to set back to Early Binding (without the reference to Word),
beforehand convert any named constants you see in the examples to their
intrinsic values. In the Immediate window type (say)
?wdAdverb

and hit enter (wdAdverb = 2)

Regards,
Peter T

 

[Nedan Nedzatra]

Brilliant.

Thank You.

Following gets 'some' results but nothing like the extensive list returned
with Shift F7 in Word. Maybe there's a different way!

Option Explicit
Private mObjWord As Object

Sub test()
Dim i As Long
Dim sWord As String
Dim arr

sWord = "some"

If GetMeanings(sWord, arr) Then
For i = LBound(arr) To UBound(arr)
Debug.Print arr(i)
Next

End If

' call AllDone ' when done

End Sub

Sub AllDone()
Set mObjWord = Nothing
End Sub

Function GetMeanings(myWord As String, vMeanings)
Dim objSynonymInfo As Object

If mObjWord Is Nothing Then
Set mObjWord = CreateObject("word.application")
End If

Set objSynonymInfo = mObjWord.SynonymInfo(myWord)

vMeanings = objSynonymInfo.MeaningList

GetMeanings = UBound(vMeanings) > 0

Exit Function
errExit:

End Function


Don't forget to clean up the Word object when done

Regards,
Peter T





.

 

[Nedan Nedzatra]

Brilliant.

Thank You.

Following gets 'some' results but nothing like the extensive list returned
with Shift F7 in Word. Maybe there's a different way!

Option Explicit
Private mObjWord As Object

Sub test()
Dim i As Long
Dim sWord As String
Dim arr

sWord = "some"

If GetMeanings(sWord, arr) Then
For i = LBound(arr) To UBound(arr)
Debug.Print arr(i)
Next

End If

' call AllDone ' when done

End Sub

Sub AllDone()
Set mObjWord = Nothing
End Sub

Function GetMeanings(myWord As String, vMeanings)
Dim objSynonymInfo As Object

If mObjWord Is Nothing Then
Set mObjWord = CreateObject("word.application")
End If

Set objSynonymInfo = mObjWord.SynonymInfo(myWord)

vMeanings = objSynonymInfo.MeaningList

GetMeanings = UBound(vMeanings) > 0

Exit Function
errExit:

End Function


Don't forget to clean up the Word object when done

Regards,
Peter T





.