VBA Language Convertor

Vishesh's picture
Here is a simple function to convert a text from one language to another. Call the function with the required parameters...1. text to convert, 2. source language, 3. language to convert into.
Function TranslateText(strTextToConvert As String, strInputLang As _
 String, strOutputLang As String)
 
    Dim objInternetExplorer     As Object
    Dim lngLoop                 As Long
    Dim strInputLangId          As String
    Dim strOutputLangId         As String
    Dim strTempOutput           As String
    Dim varCleanData            As Variant
 
    If strTextToConvert = "" Then Exit Function
 
    ' Tools Reference Select Microsoft internet Control
    Set objInternetExplorer = CreateObject("InternetExplorer.application")
 
    'INPUT LANGUAGE
    If strInputLang = "" Then
        strInputLangId = "auto"
    Else
        strInputLangId = GetLanguageIds(strInputLang)
    End If
 
    'OUTPUT LANGUAGE
    strOutputLangId = GetLanguageIds(strOutputLang)
 
    If strOutputLangId = "" Or strInputLangId = "" Then
        TranslateText = strTextToConvert
        Exit Function
    End If
    'open website
    objInternetExplorer.Visible = False
    objInternetExplorer.navigate "http://translate.google.com/#" & _
 strInputLangId & "/" & strOutputLangId & "/" & strTextToConvert
 
    Do Until objInternetExplorer.ReadyState = 4
        DoEvents
    Loop
 
    Application.Wait (Now + TimeValue("0:00:5"))
 
    Do Until objInternetExplorer.ReadyState = 4
        DoEvents
    Loop
 
    varCleanData = Split(Application.WorksheetFunction.Substitute(objInternetExplorer. _
Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
 
    For lngLoop = LBound(varCleanData) To UBound(varCleanData)
        strTempOutput = strTempOutput & Right(varCleanData(lngLoop),  _
Len(varCleanData(lngLoop)) - InStr(varCleanData(lngLoop), ">"))
    Next lngLoop
 
    TranslateText = strTempOutput
 
    objInternetExplorer.Quit
    Set objInternetExplorer = Nothing
 
End Function
 
Function GetLanguageIds(strLang As String) As String
 
    Dim strLangIds      As String
    Dim arrLangIds      As Variant
    Dim strId           As String
    Dim intLoop         As Integer
 
    'This is hard coded------
    strLangIds = "Afrikaans - af,Albanian - sq,Arabic - ar,Armenian - hy,Azerbaijani - az,Basque - eu,Belarusian - be,Bengali -  _
bn,Bulgarian - bg,Catalan - ca,Chinese - zh-CN,Croatian - hr,Czech - cs,Danish - da,Dutch - nl,English - en,Esperanto - eo,Estonian -  _
et,Filipino - tl,Finnish - fi,French - fr,Galician - gl,Georgian - ka,German - de,Greek - el,Gujarati - gu,Haitian Creole - ht,Hebrew - _
 iw,Hindi - hi,Hungarian - hu,Icelandic - is,Indonesian - id,Irish - ga,Italian - it,Japanese - ja,Kannada - kn,Korean - ko,Latin - _
 la,Latvian - lv,Lithuanian - lt,Macedonian - mk,Malay - ms,Maltese - mt,Norwegian - no,Persian - fa,Polish - pl,Portuguese - pt,Romanian -  _
ro,Russian - ru,Serbian - sr,Slovak - sk,Slovenian - sl,Spanish - es,Swahili - sw,Swedish - sv,Tamil - ta,Telugu - te,Thai - th,Turkish _
 - tr,Ukrainian - uk,Urdu - ur,Vietnamese - vi,Welsh - cy,Yiddish - yi"
    '========================
    arrLangIds = Split(strLangIds, ",")
 
    For intLoop = LBound(arrLangIds) To UBound(arrLangIds)
        If Split(arrLangIds(intLoop), " - ")(0) = strLang Then
            strId = Split(arrLangIds(intLoop), " - ")(1)
            Exit For
        End If
    Next intLoop
 
    GetLanguageIds = strId
    Erase arrLangIds
 
End Function

Microsoft's own translation

Did anyone write a function to use Microsoft's own Reference/Translate built-in method?

Convert text using VBA from one language to another

Hello everyone
This is interesting article to convert text using VBA from one language to another. We also have VBA code that work on MS Access form.
Here is link:
http://www.accessguru.net/Articles_MSAccess/0026-how%20to%20do%20languag...

Best Regards
Access Guru

mohan.pandey87's picture

VBA Language Convertor

Here is an another approach to translate much faster then previous one by using httprequest.

Sub test()

MsgBox getGoogleTranslation("Lion", "english", "hindi")

End Sub

Public Function getGoogleTranslation(ByVal strSource As String, ByVal strSourceLang As String, ByVal strDestLang As String) As String

Dim strURL As String
Dim strRes As String
Dim varArrLanguage() As Variant
Dim varArrGoogleLanguage() As Variant
Dim lngLangVal As Long

varArrLanguage = Array("AFRIKAANS", "ALBANIAN", "ARABIC", "BELARUSIAN", "BULGARIAN", _
"CATALAN", "CHINESE", "CHINESE SIMPLIFIED", "CHINESE TRADITIONAL", _
"CROATIAN", "CZECH", "DANISH", "DUTCH", "ENGLISH", "ESTONIAN", _
"FILIPINO", "FINNISH", "FRENCH", "GALICIAN", "GERMAN", "GREEK", _
"HEBREW", "HINDI", "HUNGARIAN", "ICELANDIC", "INDONESIAN", "IRISH", _
"ITALIAN", "JAPANESE", "KOREAN", "LATVIAN", "LITHUANIAN", "MACEDONIAN", _
"MALAY", "MALTESE", "NORWEGIAN", "PERSIAN", "POLISH", "PORTUGUESE", _
"ROMANIAN", "RUSSIAN", "SERBIAN", "SLOVAK", "SLOVENIAN", "SPANISH", _
"SWAHILI", "SWEDISH", "TAGALOG", "THAI", "TURKISH", "UKRAINIAN", _
"VIETNAMESE", "WELSH", "YIDDISH")

varArrLanguage = Application.Transpose(Application.Transpose(varArrLanguage))

varArrGoogleLanguage = Array("af", "sq", "ar", "be", "bg", _
"ca", "zh", "zh-CN", "zh-TW", _
"hr", "cs", "da", "nl", "en", "et", _
"tl", "fi", "fr", "gl", "de", "el", _
"iw", "hi", "hu", "is", "id", "ga", _
"it", "ja", "ko", "lv", "lt", "mk", _
"ms", "mt", "no", "fa", "pl", "pt-PT", _
"ro", "ru", "sr", "sk", "sl", "es", _
"sw", "sv", "tl", "th", "tr", "uk", _
"vi", "cy", "yi")

varArrGoogleLanguage = Application.Transpose(Application.Transpose(varArrGoogleLanguage))

lngLangVal = 0
On Error Resume Next
lngLangVal = WorksheetFunction.Match(UCase(Trim(strSourceLang)), varArrLanguage, 0)
On Error GoTo 0: Err.Clear
If lngLangVal > 0 Then
strSourceLang = varArrGoogleLanguage(lngLangVal)
Else
strSourceLang = vbNullString
End If

lngLangVal = 0
On Error Resume Next
lngLangVal = WorksheetFunction.Match(LCase(Trim(strDestLang)), varArrLanguage, 0)
On Error GoTo 0: Err.Clear
If lngLangVal > 0 Then
strDestLang = varArrGoogleLanguage(lngLangVal)
Else
strDestLang = vbNullString
End If

If strSourceLang <> vbNullString Or strDestLang <> vbNullString Then
strURL = strURL & "http://translate.google.com/translate_a/t?client=t&text="
strURL = strURL & Replace(strSource, " ", "%20")
strURL = strURL & "&hl=en&sl=" & strSourceLang
strURL = strURL & "&tl=" & strDestLang & "&multires=1&pc=0&rom=1&sc=1"

With CreateObject("msxml2.xmlhttp")
.Open "get", strURL, False
.send
strRes = .responseText
End With

getGoogleTranslation = Replace(Replace(Split(strRes, ",")(0), "[", ""), """", "")
Else
getGoogleTranslation = vbNullString
End If

End Function

TRANSLATE

THANKS FOR THIS CODE.
IT IS VERYMUCH USEFUL FOR ME.
ALTHOUGH IT WORKING PARTLY.
SOME WORDS ARE NOT TRNSLATING RPOPERLY.

Vishesh's picture

Thanks for sharing the

Thanks for sharing the knowledge and a better approach. Would be good if you could upload some learning modules on how to extract data from web.