Public Const BAIDU_APP_ID = "XXXXXXXXXXXXXXXXXXXXX" '在百度申请后得到
Public Const BAIDU_APP_KEY = "XXXXXXXXXXXXXXXXXXXXXX" '在百度申请后得到 

Public Type MD5_CTX
 dwNUMa As Long
 dwNUMb As Long
 Buffer(15) As Byte
 cIN(63) As Byte
 cDig(15) As Byte
End Type
 
Public Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long,ByVal dwFlags As Long,ByVal lpWideCharStr As Long,ByVal cchWideChar As Long,ByRef lpMultiByteStr As Any,ByVal cchMultiByte As Long,ByVal lpDefaultChar As String,ByVal lpUsedDefaultChar As Long) As Long
Public Declare Sub MD5Final Lib "advapi32" (lpContext As MD5_CTX)
Public Declare Sub MD5Init Lib "advapi32" (lpContext As MD5_CTX)
Public Declare Sub MD5Update Lib "advapi32" (lpContext As MD5_CTX,ByRef lpBuffer As Any,ByVal BufSize As Long)

Public Function Translate(ByVal Text As String,Optional ByVal Source As String = "auto",Optional ByVal Target As String = "auto",Optional ByVal AppID As String = BAIDU_APP_ID,Optional ByVal Key As String = BAIDU_APP_KEY) As String
 Dim XML As Object,stcContext As MD5_CTX,URL As String,PostData As String,Salt As String
 Dim Arr() As Byte,I As Long,Result As String
 URL = "http://api.fanyi.baidu.com/api/trans/vip/translate"
 Randomize
 Salt = Replace(Rnd,".","")
 MD5Init stcContext
 PostData = "q=" & Text
 PostData = PostData & "&appid=" & AppID
 PostData = PostData & "&salt=" & Salt
 PostData = PostData & "&from=" & Source
 PostData = PostData & "&to=" & Target
 PostData = PostData & "&sign="
 I = Len(AppID & Text & Salt & Key)
 ReDim Arr(I * 3)
 I = WideCharToMultiByte(65001,StrPtr(AppID & Text & Salt & Key),I,Arr(0),I * 3 + 1,vbNullString,0)
 If I < 1 Then Exit Function
 MD5Update stcContext,I
 MD5Final stcContext
 For I = 0 To UBound(stcContext.cDig)
 PostData = PostData & LCase(IIf(stcContext.cDig(I) < 16,"0" & Hex(stcContext.cDig(I)),Hex(stcContext.cDig(I))))
 Next
 Set XML = CreateObject("WinHttp.WinHttpRequest.5.1")
 XML.Option(6) = False
 XML.Option(4) = 13056
 XML.Open "POST",URL
 XML.SetRequestHeader "Content-Type","application/x-www-form-urlencoded"
 XML.SetRequestHeader "Content-Length",LenB(StrConv(PostData,vbFromUnicode))
 XML.Send PostData
 PostData = XML.ResponseText
 Set XML = Nothing
 I = InStr(PostData,"error_code")
 If I > 0 Then
 Result = "错误代码:" & Mid(PostData,I + 13,InStr(I + 13,PostData,"""") - I - 13)
 I = InStr(PostData,"error_msg")
 Result = Result & ",说明:" & Mid(PostData,I + 12,InStr(I + 12,"""") - I - 12)
 Else
 I = 1
 PostData = Replace(PostData,"\""","\'")
 Do Until InStr(I,"""dst"":""") = 0
 I = InStr(I,"""dst"":""") + 7
 Result = IIf(Len(Result) = 0,"",Result & vbCrLf) & Mid(PostData,InStr(I,"""") - I)
 Loop
 Result = Replace(Result,"\'","""")
 ReDim Arr(1)
 Do Until InStr(Result,"\u") = 0
 I = InStr(Result,"\u")
 Result = Replace(Result,Mid(Result,6),ChrW("&H" & Mid(Result,I + 2,4)))
 Loop
 End If
 Translate = Result
End Function

调用方法

Debug.Print Translate("你好")