在 VBA 中查找单词的英文定义
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5981547/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Finding the English definition of a word in VBA
提问by Derek
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")'.
在 Excel 中，如果我在一个单元格中输入单词“PIZZA”，选择它，然后按 SHIFT+F7，我可以得到我最喜欢的食物的英文词典定义。很酷。但我想要一个能做到这一点的函数。类似于'=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?
有没有办法通过 VBA 脚本访问微软的研究数据？我正在考虑使用 JSON 解析器和免费的在线词典，但 Excel 似乎内置了一个不错的词典。关于如何访问它的任何想法？
采纳答案by ray
In case VBA's Research object doesn't work out, you can try the Google Dictionary JSON method as so:
如果 VBA 的 Research 对象不起作用，您可以尝试 Google Dictionary JSON 方法，如下所示：
First, add a reference to "Microsoft WinHTTP Services".
首先，添加对“Microsoft WinHTTP 服务”的引用。
After you see my mad, JSON parsing skillz, you may also want to add your favorite VB JSON parser, like this one.
看到我疯狂的 JSON 解析技巧之后，你可能还想添加你最喜欢的 VB JSON 解析器，就像这个。
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")
=DefineWord("lionize")
回答by Steve Mallory
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.
要查询，您需要有效 Web 服务的 GUID。不过，我一直无法找到 Microsoft 内置服务的 GUID。
