相信在這地球村的年代,會很常遇到需要翻譯的情境,有時處理一些資料時,會需要翻譯,而且最好是系統化的批次處理,此時如果開網頁版的Google翻譯,反覆的複製貼上,再複製貼回Excel或Access中儲存,是十分瑣碎的,這部份,可以透過VBA撰寫程式來處理,將會省時省事些,
以下程式請複製到模組中:
Function GoogleTranslate2(strInput As String, _
Optional inputstring As String = "auto", _
Optional outputstring As String = "zh-TW", _
Optional bnDebug As Boolean = False _
) As String
' 參考:http://stackoverflow.com/questions/19098260/translate-text-using-vba
' 改用XMLHTTP
Dim WinHttpReq As Object
Dim i As Long
Dim text_to_convert As String, result_data As String, CLEAN_DATA
Dim strULR As String
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
text_to_convert = URLEncodeUTF8(strInput)
'strULR = "https://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert & ""
strULR = "https://translate.google.com/m?hl=" & outputstring & "&sl=" & inputstring & "&tl=" & outputstring & "&ie=UTF-8&prev=_m&q=" & text_to_convert & ""
If bnDebug Then Debug.Print "網址:" & vbCrLf & strULR
WinHttpReq.Open "GET", strULR, False
WinHttpReq.send
strData = WinHttpReq.responsetext
'確認回傳的狀態是否正常,200代表正常
If WinHttpReq.Status = 200 Then
If bnDebug Then Debug.Print "取得網頁內容:" & vbCrLf & strData
strCutStart = "<div dir=""ltr"" class=""t0"">"
strData = Mid(strData, InStr(1, strData, strCutStart, vbBinaryCompare) + Len(strCutStart))
strData = Mid(strData, 1, InStr(1, strData, "</div>", vbBinaryCompare) - 1)
CLEAN_DATA = Split(strData, "<")
For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
Next
End If
GoogleTranslate2 = HTMLToChr(result_data)
'語言附註:
'auto,偵測語言
'zh-TW,中文(繁體)
'es,西班牙文
'en,英文
'
'tr,土耳其文 'af,布爾文
'zh-TW,中文(繁體) 'fy,弗利然文
'zh-CN,中文(簡體) 'be,白俄羅斯文
'da,丹麥文 'lt,立陶宛文
'eu,巴斯克文 'ig,伊博文
'ja,日文 'is,冰島文
'mi,毛利文 'hu,匈牙利文
'jw,爪哇文 'id,印尼文
'gl,加里西亞文 'su,印尼巽他文
'ca,加泰羅尼亞文 'hi,印度文
'kn,卡納達文 'gu,印度古哈拉地文
'ne,尼泊爾文 'ky,吉爾吉斯文
'es,西班牙文 'bs,波西尼亞
'hr,克羅埃西亞文 'fa,波斯文
'iw,希伯來文 'pl,波蘭文
'el,希臘文 'fi,芬蘭文
'hy,亞美尼亞文 'am,阿姆哈拉文
'az,亞塞拜然文 'ar,阿拉伯文
'ny,奇切瓦文 'sq,阿爾巴尼亞文
'bn,孟加拉文 'ru,俄文
'ps,帕施圖文 'bg,保加利亞文
'la,拉丁文 'sd,信德文
'lv,拉脫維亞文 'xh,南非柯薩文
'fr,法文 'zu,南非祖魯文
'kk,哈薩克文 'ht,海地克里奧文
'cy,威爾斯文 'uk,烏克蘭文
'co,科西嘉文 'uz,烏茲別克文
'hmn,苗文 'ur,烏爾都文
'en,英文 'so,索馬里文
'haw,夏威夷文'mt,馬耳他文
'ku,庫德文 'ms,馬來文
'no,挪威文 'mk,馬其頓文
'pa,旁遮普文 'mg,馬拉加斯文
'th,泰文 'mr,馬拉地文
'ta,泰米爾文 'ml,馬拉雅拉姆文
'te,泰盧固文 'km,高棉文
'eo,國際語文 'sr,塞爾維亞文
'ceb,宿霧文 'yi,意第緒文
'cs,捷克文 'et,愛沙尼亞文
'sn,紹納文 'ga,愛爾蘭文
'nl,荷蘭文 'sv,瑞典文
'ka,喬治亞文 'st,瑟索托文
'sw,斯瓦希里文 'it,義大利文
'sk,斯洛伐克文 'pt,葡萄牙文
'sl,斯洛維尼亞文 'mn,蒙古文
'tl,菲律賓文 'ha,豪沙文
'vi,越南文 'lo,寮文
'tg,塔吉克文 'de,德文
'my,緬甸文
'lb,盧森堡文
'si,錫蘭文
'yo,優魯巴文
'ko,韓文
'sm,薩摩亞文
'ro,羅馬尼亞文
'gd,蘇格蘭的蓋爾文
End Function
這篇也是參考他人的寫法改的程式,原程式是使用IE物件來抓取資料,執行時,會開啟IE視窗,個人不是那麼喜歡,除了速度慢外,使用上也會造成user的困擾,因此我嘗試改為XMLHTTP物件方式來處理,網址的連線方式也嘗試了幾種,最後選擇使用Windows行動裝置使用的網頁,讓產生的物件最少,最不佔資源,對取出翻譯資料也較為簡單。
程式中,字串檢查的InStr方法,使用上也要特別注意,如果資料來源為Unicode,只要非系統語言的文字,且後面沒又加vbBinaryCompare這種二進位比較方式的設定,InStr會很容易報錯,出現記憶體不足問題。
Unicode的資料,目前無法於VBE界面中正常顯示,建議資料寫入到資料表中再進行處理會保險些。
以下為測試程式,測試後,可於Config資料檔內看到翻譯內容:
Sub GoogleTranslate2測試()
Dim strCht As String, strEN As String
Dim strES As String, strJA As String
Dim strKO As String
strCht = "傳奇再現,等待黎明"
strEN = GoogleTranslate2(strCht, , "en")
strES = GoogleTranslate2(strCht, , "es")
strJA = GoogleTranslate2(strCht, , "ja")
strKO = GoogleTranslate2(strCht, , "ko")
ConfigSave "翻譯測試:英文", strCht, strEN
ConfigSave "翻譯測試:西文", strCht, strES
ConfigSave "翻譯測試:日文", strCht, strJA
ConfigSave "翻譯測試:韓文", strCht, strKO
End Sub
翻譯後的內容如下:
以上的分享,希望各位喜歡。