13

In Excel, if I enter the word "PIZZA" into a cell, select it, and SHIFT+F7, I can get a nice English dictionary definition of my favorite food. Pretty cool. But I'd like a function that does this. Something like '=DEFINE("PIZZA")'.

Is there a way through VBA scripts to access Microsoft's Research data? I was considering using a JSON parser and a free online dictionary, but it seems like Excel has a nice dictionary built-in. Any ideas on how to access it?

halfer
  • 19,824
  • 17
  • 99
  • 186
Derek
  • 759
  • 1
  • 11
  • 20

2 Answers2

7

In case VBA's Research object doesn't work out, you can try the Google Dictionary JSON method as so:

First, add a reference to "Microsoft WinHTTP Services".

After you see my mad, JSON parsing skillz, you may also want to add your favorite VB JSON parser, like this one.

Then Create the following Public Function:

Function DefineWord(wordToDefine As String) As String

  ' Array to hold the response data.
    Dim d() As Byte
    Dim r As Research


    Dim myDefinition As String
    Dim PARSE_PASS_1 As String
    Dim PARSE_PASS_2 As String
    Dim PARSE_PASS_3 As String
    Dim END_OF_DEFINITION As String

    'These "constants" are for stripping out just the definitions from the JSON data
    PARSE_PASS_1 = Chr(34) & "webDefinitions" & Chr(34) & ":"
    PARSE_PASS_2 = Chr(34) & "entries" & Chr(34) & ":"
    PARSE_PASS_3 = "{" & Chr(34) & "type" & Chr(34) & ":" & Chr(34) & "text" & Chr(34) & "," & Chr(34) & "text" & Chr(34) & ":"
    END_OF_DEFINITION = "," & Chr(34) & "language" & Chr(34) & ":" & Chr(34) & "en" & Chr(34) & "}"
    Const SPLIT_DELIMITER = "|"

    ' Assemble an HTTP Request.
    Dim url As String
    Dim WinHttpReq As Variant
    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

    'Get the definition from Google's online dictionary:
    url = "http://www.google.com/dictionary/json?callback=dict_api.callbacks.id100&q=" & wordToDefine & "&sl=en&tl=en&restrict=pr%2Cde&client=te"
    WinHttpReq.Open "GET", url, False

    ' Send the HTTP Request.
    WinHttpReq.Send

    'Print status to the immediate window
    Debug.Print WinHttpReq.Status & " - " & WinHttpReq.StatusText

    'Get the defintion
    myDefinition = StrConv(WinHttpReq.ResponseBody, vbUnicode)

    'Get to the meat of the definition
    myDefinition = Mid$(myDefinition, InStr(1, myDefinition, PARSE_PASS_1, vbTextCompare))
    myDefinition = Mid$(myDefinition, InStr(1, myDefinition, PARSE_PASS_2, vbTextCompare))
    myDefinition = Replace(myDefinition, PARSE_PASS_3, SPLIT_DELIMITER)

    'Split what's left of the string into an array
    Dim definitionArray As Variant
    definitionArray = Split(myDefinition, SPLIT_DELIMITER)
    Dim temp As String
    Dim newDefinition As String
    Dim iCount As Integer

    'Loop through the array, remove unwanted characters and create a single string containing all the definitions
    For iCount = 1 To UBound(definitionArray) 'item 0 will not contain the definition
        temp = definitionArray(iCount)
        temp = Replace(temp, END_OF_DEFINITION, SPLIT_DELIMITER)
        temp = Replace(temp, "\x22", "")
        temp = Replace(temp, "\x27", "")
        temp = Replace(temp, Chr$(34), "")
        temp = iCount & ".  " & Trim(temp)
        newDefinition = newDefinition & Mid$(temp, 1, InStr(1, temp, SPLIT_DELIMITER) - 1) & vbLf  'Hmmmm....vbLf doesn't put a carriage return in the cell. Not sure what the deal is there.
    Next iCount

    'Put list of definitions in the Immeidate window
    Debug.Print newDefinition

    'Return the value
    DefineWord = newDefinition

End Function

After that, it's just a matter of putting the function in your cell:

=DefineWord("lionize")

ray
  • 8,521
  • 7
  • 44
  • 58
  • 2
    Alright this isn't exactly the route I'd wanted, but it works too damn well. Nicely done sir. I'm still going to play around with the "Research" object for fun, but the above code is great to have. – Derek May 14 '11 at 01:46
  • 2
    If this answer helped you, you should consider marking it as the answer. – JimmyPena Nov 18 '11 at 17:19
  • In the year 2018: the Google dictionary URL used in the script is not working any more. Suggestions? – Christian Geiselmann Dec 18 '18 at 23:45
  • Question: The note about your "mad JSON paring skills": is installing this VBJSON thing mandatory for making this function work? Or did you just mention it without it being really relevant here? – Christian Geiselmann Dec 18 '18 at 23:47
  • Hello. Im a noob without knowledges in VBA. Could you explain me how to do that? And if it is posible with other languages. Thanks! – GermanJablo Apr 29 '20 at 14:31
2

via the Research object

Dim rsrch as Research
rsrch.Query( ...

To query, you need the GUID of a valid web service. I haven't been able to find the GUID's for Microsoft's built in service though.

Steve Mallory
  • 4,245
  • 1
  • 28
  • 31