问如何在Excel中快速定义单词列表

EN

Option Explicit

Const URL_SEARCH = "http://dictionary.reference.com/browse/<WORD>?s=t"

Function DictReference(ByVal SearchWord As Variant) As String
    On Error Resume Next
    Dim sWord As String, sTxt As String
    sWord = CStr(SearchWord)
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", Replace(URL_SEARCH, "<WORD>", sWord), False
        .Send
        If .Status = 200 Then
            sTxt = StrConv(.ResponseBody, vbUnicode)
            ' The definition of the searched word is in div class "def-content"
            sTxt = Split(sTxt, "<div class=""def-content"">")(1)
            sTxt = Split(sTxt, "</div>")(0)
            ' Remove all unneccessary whitespaces
            sTxt = Replace(sTxt, vbLf, "")
            sTxt = Replace(sTxt, vbCr, "")
            sTxt = Replace(sTxt, vbCrLf, "")
            sTxt = Trim(sTxt)
            ' Remove any HTML codes within
            sTxt = StripHTML(sTxt)
        Else
            sTxt = "WinHttpRequest Error. Status: " & .Status
        End If
    End With
    If Err.Number <> 0 Then sTxt = "Err " & Err.Number & ":" & Err.Description
    DictReference = sTxt
End Function

Private Function StripHTML(ByVal sHTML As String) As String
    Dim sTmp As String, a As Long, b As Long
    sTmp = sHTML
    Do Until InStr(1, sTmp, "<", vbTextCompare) = 0
        a = InStr(1, sTmp, "<", vbTextCompare) - 1
        b = InStr(a, sTmp, ">", vbTextCompare) + 1
        sTmp = Left(sTmp, a) & Mid(sTmp, b)
    Loop
    StripHTML = sTmp
End Function