完整的tk算法：

//源自http://translate.google.cn/
TKK=eval('((function(){var a\x3d618632403;var b\x3d1485484074;return 412204+\x27.\x27+(a+b)})())');
//会变动

var 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函数
strText = GetReponseText(objHTTP, strURL)
TKKFunc = "TKK=" & Split(Split(strText, "TKK=")(1), "');")(0) & "');"

'获取其他函数
strText = GetReponseText(objHTTP, strURL)
OtherFunc = "var gk=" & Split(Split(strText, "var gk=")(1), "var kk=")(0)

'合成完整的tk算法函数，并加上html代码：
strJSScript = "<html><script>" & TKKFunc & OtherFunc & "</script></html>"

'计算单词的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
& 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<a[0].length-1;i++)s+=a[0][i][0];return s}"
strJSScript = "<html><script>" & DataFunc & "</script></html>"

'获取翻译
objHTML.write strJSScript
GoogleTranslate = CallByName(objHTML.parentwindow, "getdata", VbMethod, strText)

Set objHTTP = Nothing
Set objHTML = Nothing
End Function

Private Function GetReponseText(objHTTP As Object, strURL As String)
With objHTTP
.Open "GET", strURL, False
End Function