VBA Language Convertor
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
»
- Vishesh's blog
- Login or register to post comments
- 60483 reads
Please help
Hi,
post using the function transulatetext, its giving the original value which is present in the cell
for ex:
cells(A1) is Present
=transulatetext(A1,"en","fr")
result is "Present"
Can you please help me with debugging
please do reply
Facing issue with Function
Hi,
i am trying to call the function but it just giving the same input text.
for example:
text in A1 cell is "Good morning"
after coping the function code... and executing
=TransulateText(A1,"en","fr")
and the result is "Good morning"
please help me with de-bugging
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
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
Facing issue with Function
Hi,
Result of the code is empty, can you please help me with de-bugging
TRANSLATE
THANKS FOR THIS CODE.
IT IS VERYMUCH USEFUL FOR ME.
ALTHOUGH IT WORKING PARTLY.
SOME WORDS ARE NOT TRNSLATING RPOPERLY.
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.