完整的tk算法：

//源自http://translate.google.cn/TKK=eval('((function(){var a\x3d618632403;var b\x3d1485484074;return 412204+\x27.\x27+(a+b)})())');//会变动//源自http://translate.google.cn/translate/releases/twsfe_20161212_RC00/r/js/desktop_module_main.jsvar gk = function(a) {    return function() {        return a    }},hk = function(a, b) {    for (var c = 0; c < b.length - 2; c += 3) {        var d = b.charAt(c + 2), d = "a" <= d ? d.charCodeAt(0) - 87 : Number(d), d = "+" == b.charAt(c + 1) ? a >>> d : a << d;        a = "+" == b.charAt(c) ? a + d & 4294967295 : a ^ d    }    return a},ik = null, jk = function(a) {    var b;    if (null !== ik)        b = ik;    else {        b = gk(String.fromCharCode(84));        var c = gk(String.fromCharCode(75));        b = [b(), b()];        b[1] = c();        b = (ik = window[b.join(c())] || "") || ""    }    var d = gk(String.fromCharCode(116)), c = gk(String.fromCharCode(107)), d = [d(), d()];    d[1] = c();    c = "&" + d.join("") +    "=";    d = b.split(".");    b = Number(d[0]) || 0;    for (var e = [], f = 0, g = 0; g < a.length; g++) {        var l = a.charCodeAt(g);        128 > l ? e[f++] = l : (2048 > l ? e[f++] = l >> 6 | 192 : (55296 == (l & 64512) && g + 1 < a.length && 56320 == (a.charCodeAt(g + 1) & 64512) ? (l = 65536 + ((l & 1023) << 10) + (a.charCodeAt(++g) & 1023), e[f++] = l >> 18 | 240, e[f++] = l >> 12 & 63 | 128) : e[f++] = l >> 12 | 224, e[f++] = l >> 6 & 63 | 128), e[f++] = l & 63 | 128)    }    a = b;    for (f = 0; f < e.length; f++)        a += e[f], a = hk(a, "+-a^+6");    a = hk(a, "+-3^+b+-f");    a ^= Number(d[1]) || 0;    0 > a && (a = (a & 2147483647) + 2147483648);    a %= 1E6;    return c + (a.toString() + "." +    (a ^ b))};

 

VBA代码如下：

Function GoogleTranslate(strWord As String, Optional Mode As Boolean = False) As String    'Mode为TRUE则为汉译英，为FALSE则为英译汉，默认是FALSE    Dim strURL As String    Dim strText As String    Dim strJSScript As String    Dim objHTTP As Object    Dim TKKFunc As String    Dim OtherFunc As String    Dim objHTML As Object    Dim DataFunc As String    Dim tkValue As String    Dim EncodeWord As String    Dim strMode As String        Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")    Set objHTML = CreateObject("htmlfile")        '获取TKK函数    strURL = "http://translate.google.cn/"    strText = GetReponseText(objHTTP, strURL)    TKKFunc = "TKK=" & Split(Split(strText, "TKK=")(1), "');")(0) & "');"        '获取其他函数    strURL = "http://translate.google.cn/translate/releases/twsfe_20161212_RC00/r/js/desktop_module_main.js"    strText = GetReponseText(objHTTP, strURL)    OtherFunc = "var gk=" & Split(Split(strText, "var gk=")(1), "var kk=")(0)        '合成完整的tk算法函数，并加上html代码：    strJSScript = ""        '计算单词的tk值    objHTML.write strJSScript    tkValue = CallByName(objHTML.parentwindow, "jk", VbMethod, strWord)        '将单词进行编码    EncodeWord = CallByName(objHTML.parentwindow, "encodeURIComponent", VbMethod, strWord)        '从服务器获取翻译数据    If Mode Then        strMode = "&sl=zh-CN&tl=en"    Else        strMode = "&sl=en&tl=zh-CN"    End If    strURL = "http://translate.google.cn/translate_a/single?client=t" _        & strMode & "&hl=zh-CN" _        & "&dt=at&dt=bd&dt=ex&dt=ld&dt=md&dt=qca&dt=rw&dt=rm&dt=ss&dt=t" _        & "&ie=UTF-8&oe=UTF-8&source=bh&ssel=0&tsel=0&kc=1" _        & tkValue _        & "&q=" & EncodeWord    strText = GetReponseText(objHTTP, strURL)        '自定义处理数据的js函数    DataFunc = "getdata=function(a){var s='';a=eval(a);for(var i=0;i
     
      "        '获取翻译    objHTML.write strJSScript    GoogleTranslate = CallByName(objHTML.parentwindow, "getdata", VbMethod, strText)        Set objHTTP = Nothing    Set objHTML = NothingEnd FunctionPrivate Function GetReponseText(objHTTP As Object, strURL As String)    With objHTTP        .Open "GET", strURL, False        .setRequestHeader "User-Agent", "Mozilla/4.0"        .Send        GetReponseText = .responsetext    End WithEnd Function