iT邦幫忙

2017 iT 邦幫忙鐵人賽
DAY 23
0
自我挑戰組

Access VBA的眉眉角角系列 第 23

Access VBA 的眉眉角角Day23: 呼叫Google翻譯

  • 分享至 

  • xImage
  •  

相信在這地球村的年代,會很常遇到需要翻譯的情境,有時處理一些資料時,會需要翻譯,而且最好是系統化的批次處理,此時如果開網頁版的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

翻譯後的內容如下:
http://ithelp.ithome.com.tw/upload/images/20161213/20007221b0UapLsW0f.png

以上的分享,希望各位喜歡。


上一篇
Access VBA 的眉眉角角Day22: QRCode的建立
下一篇
Access VBA 的眉眉角角Day24: 樞紐分析表與交叉資料表查詢
系列文
Access VBA的眉眉角角30
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

尚未有邦友留言

立即登入留言