Translate

Sorry if code looks a little mess… the WordPress editor doesn’t like too much RegEx expressions, so you have to paste the RegEx at the end of this post.

I attach the macros that I composed to translate using the services of “Google translator”, “Bing translator”, “Linguee”.

I have not spent much time exploring the available languages, just point that the GoogleLanguageIds function already can handle most common languages and that the Bing translator provides the Klingon language. The implementation of Linguee is interesting as points to external reference texts, and although it does not give out a very clean result (probably should worked the MsgBox to show the HTML code formatted within the component, but I have not wanted to spend much more time); it is useful for reference.

I’ve explored several ways to achieve the translation using the avaliable services. My final objective was to translate a DOC file keeping all the formatting and styling in place. That part is not shown here, although code is the final working version, just ripping the Word procedures off (that part drove me nuts, and is part of a future add-in development).

Option Explicit

' The program requires references to the following:
'1. Microsoft Internet Controls (SHDocVw)(ieFrame.dll)
'2. Microsoft HTML Object Library
'3. Microsoft Shell Controls And Automation

Private oIE As Object    'SHDocVw.InternetExplorer
Private oIETmp As Object 'SHDocVw.InternetExplorer
Private hDoc As MSHTML.HTMLDocument     'Object: to refer to the HTML document returned
Private strURL As String
Private hElement As MSHTML.IHTMLElement
Private hCollection As MSHTML.IHTMLElementCollection
Private hNode As MSHTML.IHTMLDOMNode
Private hDOMDoc As MSHTML.IHTMLDOMNode2

' For UTF-8 URL Encoding
Private Const CP_UTF8 = 65001
Private Declare Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As Long, ByVal dwflags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
' -----------------------------

Private Const strSHORTCODES As String = ",af,sq,ar,hy,az,eu,be,bn,bg,ca,zh-CN,hr,cs,da,nl,en,eo,et,tl,fi,fr,gl,ka,de,el,gu,ht,iw,hi,hu,is,id,ga,it,ja,kn,ko,lo,la,lv,lt,mk,ms,mt,no,fa,pl,pt-PT,ro,ru,sr,sk,sl,es,sw,sv,ta,te,th,tr,uk,ur,vi,cy,yi"
Private Enum eLanguageId
    auto_detect = 0
    Afrikaans = 1
    Albanian = 2
    Arabic = 3
    Armenian = 4
    Azerbaijani = 5
    Basque = 6
    Belarusian = 7
    Bengali = 8
    Bulgarian = 9
    Catalan = 10
    Chinese = 11
    Croatian = 12
    Czech = 13
    Danish = 14
    Dutch = 15
    English = 16
    Esperanto = 17
    Estonian = 18
    Filipino = 19
    Finnish = 20
    French = 21
    Galician = 22
    Georgian = 23
    German = 24
    Greek = 25
    Gujarati = 26
    Haitian_Creole = 27
    Hebrew = 28
    Hindi = 29
    Hungarian = 30
    Icelandic = 31
    Indonesian = 32
    Irish = 33
    Italian = 34
    Japanese = 35
    Kannada = 36
    Korean = 37
    Lao = 38
    Latin = 39
    Latvian = 40
    Lithuanian = 41
    Macedonian = 42
    Malay = 43
    Maltese = 44
    Norwegian = 45
    Persian = 46
    Polish = 47
    Portuguese = 48
    Romanian = 49
    Russian = 50
    Serbian = 51
    Slovak = 52
    Slovenian = 53
    Spanish = 54
    Swahili = 55
    Swedish = 56
    Tamil = 57
    Telugu = 58
    Thai = 59
    Turkish = 60
    Ukrainian = 61
    Urdu = 62
    Vietnamese = 63
    Welsh = 64
    Yiddish = 65
End Enum

Public Sub sDoc_Translate()
' we should try http://www.statmt.org/moses/index.php?n=Main.HomePage
    Dim TransServer As String:  TransServer = "google"
    Dim LngFrom As String:  LngFrom = "spanish"
    Dim LngTo As String:    LngTo = "english"
    Dim strTextFrom As String
    
    If oIE Is Nothing Then fIE_Initialize
    
    msgbox getTranslation(strTextFrom, LngFrom, LngTo, TransServer)
        
    oIE.Visible = True

    Call fIE_Terminate
End Sub

'Public Sub sExcel_Translate()
'' Translate. Keep format...
'    Dim rgSelection As Excel.Range
'    Dim oCell As Excel.Range
'    Dim lgWord As Long
'    Dim lgWords As Long: lgWords = 0
'    Dim aWord() As String
'    Dim strTextFrom As String
'    Dim strTextTo As String
'
'    If Not loadExplorer(oIE) Then Exit Sub
'    If Not loadExplorer(oIETmp) Then Exit Sub
'
'    Set rgSelection = Selection
'    For Each oCell In rgSelection.Cells
'        If Not IsEmpty(oCell.Value2) Then
'        If Not IsNumeric(oCell.Value2) Then
'            strTextFrom = VBA.Trim$(oCell.Text)
'            strTextFrom = VBA.Replace$(strTextFrom, "  ", " ")
'            aWord() = VBA.Split(strTextFrom, " ")
'            If lgWords + UBound(aWord) - LBound(aWord) + 1 > 5000 Then
'                ' Delete contents
'                oCell.Value2 = vbNullString
'
'                ' Translate blocks (bunch of 5000 words)
'                Do
'                    strTextFrom = vbNullString
'                    For lgWord = LBound(aWord) To 4999
'                        strTextFrom = strTextFrom & " " & aWord(lgWord)
'                    Next lgWord
'                    oCell.Value2 = oCell.Value2 & getTranslation(strTextFrom, LngFrom, LngTo, TransServer)
'
'                    strTextFrom = vbNullString
'                    For lgWord = 5000 To UBound(aWord)
'                        strTextFrom = strTextFrom & " " & aWord(lgWord)
'                    Next lgWord
'                    aWord() = VBA.Split(strTextFrom, " ")
'                    lgWords = lgWords + UBound(aWord) - LBound(aWord) + 1 - 5000
'                Loop While lgWords > 5000
'                oCell.Value2 = oCell.Value2 & getTranslation(strTextFrom, LngFrom, LngTo, TransServer)
'            Else
'                oCell.Value2 = getTranslation(strTextFrom, LngFrom, LngTo, TransServer)
'            End If
'        End If
'        End If
'    Next oCell
'
'    Call closeExplorer(oIE)
'    Call closeExplorer(oIETmp)
'End Sub
'
'Private Sub sTranslate()
'' Select translation service: "google", "bing", "linguee"
'    Dim strService As String
'    Dim lgRetVal As Long
'
'    strService = VBA.InputBox("Select translation service: [google, bing, linguee]", "Service", "google")
'    lgRetVal = MsgBox(getTranslation("Lion", "english", "spanish", strService), vbInformation + vbOKOnly)
'End Sub
'
'Private Function loadExplorer(ByRef oIE As Object) As Boolean
'    On Error GoTo ErrControl
'
'    If oIE Is Nothing Then
'        Set oIE = CreateObject("InternetExplorer.Application")
'    End If
'    loadExplorer = True
'
'ExitProc:
'    On Error GoTo 0
'    Exit Function
'
'ErrControl:
'    GoTo ExitProc
'End Function
'
'Private Function closeExplorer(ByRef oIE As Object) As Boolean
'    On Error GoTo ErrControl
'
'    oIE.Quit
'    Set oIE = Nothing
'
'    closeExplorer = True
'
'ExitProc:
'    On Error GoTo 0
'    Exit Function
'
'ErrControl:
'    GoTo ExitProc
'End Function

Private Function getWordTranslated(ByVal strSourceString As String, _
                                   ByVal strInputLang As String, _
                                   ByVal strOutputLang As String, _
                                   Optional ByVal strService As String = "Google") As String
    Dim strTranslation As String
    
    Do
        strTranslation = getTranslation(VBA.Trim$(strSourceString), strInputLang, strOutputLang, strService)
    Loop While VBA.Right$(strTranslation, 3) = "..."
    
    getWordTranslated = strTranslation
End Function

Private Sub sTranslate()
    Dim strSourceString As String: strSourceString = "Aquí una prueba de esto/ que es una prueba"
    Dim strInputLang As String: strInputLang = "spanish"
    Dim strOutputLang As String: strOutputLang = "english"
    Dim strService As String: strService = "bing"

    MsgBox getTranslation(strSourceString, strInputLang, strOutputLang, strService)
End Sub

Following is the main translator procedure:

Private Function getTranslation(ByVal strSourceString As String, _
                                ByVal strInputLang As String, _
                                ByVal strOutputLang As String, _
                                Optional ByVal strService As String = "Google") As String
    Dim strURL As String
    Dim strRes As String

    Dim strInputLangId As String
    Dim strOutputLangId As String
    Dim strTranslationElementID As String
    Dim strTempOutput As String
    Dim strHTML As String
    Dim aCleaData() As String
    Dim lngLoop As Long
    Dim bQuitExplorer As Boolean
    Dim bComplete As Boolean

    If strSourceString = "" Then Exit Function
    
    'INPUT LANGUAGE
    strInputLang = VBA.LCase$(strInputLang)
    If strInputLang = "" Then
        strInputLangId = "auto"
    Else
        strInputLangId = GoogleLanguageIds(strInputLang)
    End If

    'OUTPUT LANGUAGE
    strOutputLang = VBA.LCase$(strOutputLang)
    strOutputLangId = GoogleLanguageIds(strOutputLang)

    If strInputLang <> vbNullString And strOutputLang <> vbNullString Then
        If oIE Is Nothing Then fIE_Initialize
        
        'open Explorer instance
        'oIE.Visible = False

        strService = VBA.Trim$(VBA.LCase$(strService))

        If strService = vbNullString Then strService = "google"

        If strService = "google" Then
            
            strURL = "https://translate.google.com/#view=home" & _
                     "&op=translate" & _
                     "&sl=" & strInputLangId & _
                     "&tl=" & strOutputLangId & _
                     "&text=" & URLEncode(strSourceString)
            
            'strURL = "http://translate.google.com/translate_a/t?client=t" & _
                     "&text=" & URLEncode(strSourceString) & _
                     "&hl=en" & _
                     "&sl=" & strInputLangId & _
                     "&tl=" & strOutputLangId & _
                     "&multires=1" & _
                     "&pc=0" & _
                     "&rom=1" & _
                     "&sc=1"
            
            'strURL = "https://translate.google.com/#" & _
                     strInputLangId & "/" & _
                     strOutputLangId & "/" & _
                     strSourceString
            
            strTranslationElementID = "tlid-translation translation"

        ElseIf strService = "bing" Then
            strURL = "http://www.bing.com/translator/?text=" & _
                     URLEncode(strSourceString, True) & _
                     "&from=" & strInputLangId & "/" & _
                     "&to=" & strOutputLangId
            strTranslationElementID = "t_txtoutblk"

        ElseIf strService = "linguee" Then
            strURL = "https://www.linguee.com/" & _
                     strInputLang & "-" & _
                     strOutputLang & _
                     "/search?source=auto" & _
                     "&query=" & URLEncode(strSourceString, True)

            'strURL = "https://www.linguee.es/" & _
                     getTranslation(strInputLang, "en", "es") & "-" & _
                     getTranslation(strOutputLang, "en", "es") & _
                     "/traduccion/" & _
                     URLEncode(strSourceString, True) & ".html"

            strTranslationElementID = "lingueecontent"
        End If

        'open website
        If fIE_Load(strURL, False) Then
            Call fIE_Document

            Do Until oIE.readyState = 4
                DoEvents
            Loop
    
            Do Until oIE.readyState = 4
                DoEvents
            Loop
    
            'Get return HTML code
            oIE.Visible = True
            
            ' get translated node item
            If strService = "google" Then
                bComplete = False
                Do
                    Set hCollection = hDoc.getElementsByClassName(strTranslationElementID)
                    If hCollection.Length = 1 Then
                        bComplete = True
                        For Each hElement In hCollection
                            strTempOutput = hElement.innerText
                        Next hElement
                    End If
                    If (VBA.Trim$(strTempOutput) = vbNullString And VBA.Trim$(strSourceString) <> vbNullString) Then
                        WordWait 5 'although is readyState = COMPLETE the oIE could be still working to get the DOM structure...
                    Else
                        bComplete = True
                    End If
                    If VBA.Right$(strTempOutput, 3) = "..." Then bComplete = False
                Loop Until bComplete
                getTranslation = strTempOutput
            Else
                getTranslation = oIE.Document.getElementById(strTranslationElementID).innerText
            End If
        End If

        'If bQuitExplorer Then
        '    oIE.Quit
        '    Set oIE = Nothing
        'End If
    Else
        getTranslation = vbNullString
    End If

End Function

For the Google service we need a procedure to select languages:

Private Function GoogleLanguageIds(ByVal strLang As String) As String
    Dim strLangIds As String
    Dim arrLangIds() As String
    Dim strId As String
    Dim intLoop As Integer

    GoogleLanguageIds = VBA.Switch(strLang = "chinese", "zh-CN", _
                                   strLang = "danish", "da", _
                                   strLang = "dutch", "nl", _
                                   strLang = "english", "en", _
                                   strLang = "french", "fr", _
                                   strLang = "german", "de", _
                                   strLang = "greek", "el", _
                                   strLang = "italian", "it", _
                                   strLang = "japanese", "ja", _
                                   strLang = "norwegian", "no", _
                                   strLang = "polish", "pl", _
                                   strLang = "portuguese", "pt", _
                                   strLang = "romanian", "ro", _
                                   strLang = "russian", "ru", _
                                   strLang = "spanish", "es", _
                                   strLang = "swedish", "sv", _
                                   strLang = "Turkish", "tr", _
                                   strLang = "ukrainian", "uk")
    
    'Dim LanguageId As eLanguageId
    'GoogleLanguageIds = VBA.Split(strSHORTCODES, ",")(LanguageId)
End Function

Instead of using the Internet Explorer object, we could have chosen the XMLHTTP object, much faster, but completely hidden from user. And one point I didn’t like, it is usually recognised as a robot, and banned; so I prefer keeping the IE way, the XMLHTTP is just for reference (and, if you are for using with an API key, this should be the way to go):

Private Function ServerXMLHTTPTranslate(ByVal strSourceString As String, _
                                        ByVal strInputLang As String, _
                                        ByVal strOutputLang As String, _
                                        Optional ByVal strService As String = "Google") As String
    Dim strURL As String
    Dim trans As String
    Dim oHTTP As Object
    Dim strInputLangId As String
    Dim strOutputLangId As String
    
    Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    strURL = "https://translate.google.com/m?" & _
             "hl=" & strInputLangId & _
             "&sl=" & strInputLangId & _
             "&tl=" & strOutputLangId & _
             "&ie=UTF-8" & _
             "&prev=_m" & _
             "&q=" & URLEncode(strSourceString)
    With oHTTP
        .Open "GET", strURL, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        .send ("")
        If InStr(.responseText, "div dir=""ltr""") > 0 Then
            trans = ... here put the code mentioned outside this block of code (mess of the WordPress Plugin with RegEx expressions
            MsgBox UnEncodeURL(trans)
        Else
            MsgBox ("Error")
        End If
    End With
End Function

Private Function GoogleTranslateAPI(ByVal text As String, _
                                    ByVal srcLang As String, _
                                    ByVal resLang As String) As String
' Needs an API key
    Dim jsonProvider As Object
    Dim jsonResult As Object
    Dim jsonResultText As String
    Dim googleApiUrl As String
    Dim googleApiKey As String
    Dim resultText As String
    
    Set jsonProvider = CreateObject("MSXML2.ServerXMLHTTP")
    
    text = URLEncode(text)
'!!!!!!!!!!!!!!!!!
Stop
'https://cloud.google.com/translate/pricing?hl=en
'https://cloud.google.com/products/calculator/
'If you get a 403 error, add payment method
    googleApiKey = "..." ' GOOGLE API KEY
'!!!!!!!!!!!!!!!!!
    
    googleApiUrl = "https://translation.googleapis.com/language/translate/v2?key=" & googleApiKey & "&source=" & srcLang & "&target=" & resLang & "&q=" & text
    
    jsonProvider.Open "POST", googleApiUrl, False
    jsonProvider.setRequestHeader "Content-type", "application/text"
    jsonProvider.send ("")
    jsonResultText = jsonProvider.responseText
    
    'Set jsonResult = jsonProvider.ParseJson(jsonResultText)
    'Set jsonResult = jsonResult("data")
    'Set jsonResult = jsonResult("translations")
    'Set jsonResult = jsonResult(1)
    
    'resultText = jsonResult("translatedText")
    
    GoogleTranslateAPI = resultText
End Function

To deal with the Internet Explorer object, we can rely on these procedures:

Private Function fIE_Initialize(Optional ByRef bIEMedium As Boolean = False) As Boolean
    'open Internet Explorer in memory, and go to website
    'Dim oIE As New InternetExplorer
    'If oIE Is Nothing Then
    If bIEMedium Then
        'Set oIE = New InternetExplorerMedium
        Set oIE = CreateObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") 'Internet Explorer Medium
        Set oIE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") 'Internet Explorer Medium
    Else
        Set oIE = CreateObject("InternetExplorer.Application")
        'Set oIE = New InternetExplorer
    End If
    'End If
    oIE.Visible = True
    
    fIE_Initialize = Not (oIE Is Nothing)
End Function

Private Function fIE_Load(Optional ByVal strURL As String = vbNullString, _
                          Optional ByVal bMedium As Boolean = False) As Boolean
    Dim Timer As Date
    
    If strURL = vbNullString Then
        strURL = VBA.InputBox("URL:", , "https://...")
    End If
    
    'Wait until IE is done loading page
    Err.Clear
    'On Error Resume Next
    oIE.navigate strURL '"http://", , , , "Content-Type: application/x-www-form-urlencoded" & vbCrLf
    Timer = VBA.Now()
    
    'On Error Resume Next
    While oIE.Busy
        Application.StatusBar = "Trying to connect..."
        DoEvents
    Wend
    
    If bMedium Then
        WordWait 5
    Else
        Do While oIE.readyState <> READYSTATE_COMPLETE
            'Application.StatusBar = "Trying to connect..."
            DoEvents
            'If (VBA.Now() - Timer) > 10000 Then 'Stop: End
        Loop
    End If
    If Err.Number = 462 Then
        If strURL Like "file:///*" Then
            fIE_Load = True
        Else
            ''Stop: End
            fIE_Load = False
        End If
    Else
        fIE_Load = True
    End If
    Err.Clear
    On Error GoTo 0
    
    Application.StatusBar = ""
End Function
    
Private Function fIE_Document() As Boolean
    'show text of HTML document returned
    Set hDoc = oIE.Document
    
    'save to file: hDoc.DocumentElement.innerHTML

    ' Also: ------------------------
    ''Create HTMLFile Object
    'Set hDoc = CreateObject("htmlfile")
    '
    ''Get the WebPage Content to HTMLFile Object
    'With CreateObject("msxml2.xmlhttp")
    '    .Open "GET", strURL, False
    '    .send
    '    '??? hDoc.body.innerHTML = .responseText
    'End With
    ' ------------------------------

End Function

Private Function fIE_Terminate() As Boolean 'ByVal oIE As InternetExplorer) 'Object

    Set hDoc = Nothing

    'close down IE and reset status bar
    ' oIE.Refresh ' Refresh if needed
    Set oIE = Nothing
    
    Application.StatusBar = ""

Err_Clear:
    If Err <> 0 Then
        Debug.Assert Err = 0
        Err.Clear
        'Resume Next
    End If
End Function

And we need some code to parse the text string to translate to the URL string, so we can feed the translator box:

Public Function UTF16To8(ByVal UTF16 As String) As String
    Dim sBuffer As String
    Dim lLength As Long
    
    If UTF16 <> "" Then
        lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, 0, 0, 0, 0)
        sBuffer = Space$(lLength)
        lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, StrPtr(sBuffer), Len(sBuffer), 0, 0)
        sBuffer = StrConv(sBuffer, vbUnicode)
        UTF16To8 = Left$(sBuffer, lLength - 1)
    Else
        UTF16To8 = ""
    End If
End Function

Public Function URLEncode(ByVal strTextSource As String, _
                          Optional ByVal SpaceAsPlus As Boolean = False, _
                          Optional ByVal UTF8Encode As Boolean = True) As String

    Dim StringValCopy As String: StringValCopy = IIf(UTF8Encode, UTF16To8(strTextSource), strTextSource)
    Dim StringLen As Long:       StringLen = VBA.Len(StringValCopy)
    Dim Result() As String
    
    If StringLen > 0 Then
        ReDim Result(1 To StringLen)
        Dim lgChr As Long
        Dim CharCode As Integer
        Dim Char As String
        Dim Space As String
        
        If SpaceAsPlus Then Space = "+" Else Space = "%20"
        
        For lgChr = 1 To StringLen
            Char = Mid$(StringValCopy, lgChr, 1)
            CharCode = Asc(Char)
            Select Case CharCode
                Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
                    Result(lgChr) = Char
                Case 32
                    Result(lgChr) = Space
                Case 0 To 15
                    Result(lgChr) = "%0" & Hex(CharCode)
                Case Else
                    Result(lgChr) = "%" & Hex(CharCode)
            End Select
        Next lgChr
        URLEncode = Join(Result, "")
    End If

    ' It can also be achieved via JavaScript:
        'Dim ScriptEngine As ScriptControl: Set ScriptEngine = New ScriptControl
        'Dim ScriptEngine As Object: Set ScriptEngine = CreateObject("ScriptControl")
        'ScriptEngine.Language = "JScript"
        'ScriptEngine.AddCode "function encode(f) {return encodeURIComponent(f);}"
        'URLEncode = ScriptEngine.Run("encode", strTextSource)
        'Set ScriptEngine = Nothing

End Function

Public Function UnEncodeURL(ByVal URLEncoded As String) As String
' revert urlencoded characters to regular texts
    Dim ibyte As Integer
    Dim txt As String
    Dim hexChr As String

    txt = URLEncoded
    
    ' replace '+' with space
    txt = Replace(txt, "+", " ")
    
    For ibyte = 1 To 255
        Select Case ibyte
            Case 1 To 15: hexChr = "%0" & Hex(ibyte)
            Case 37: ' skip '%' character
            Case Else: hexChr = "%" & VBA.Hex(ibyte)
        End Select
        
        txt = VBA.Replace(txt, VBA.UCase$(hexChr), VBA.Chr(ibyte))
        txt = VBA.Replace(txt, VBA.LCase$(hexChr), VBA.Chr(ibyte))
    Next ibyte
    
    'replace '%' character
    txt = VBA.Replace(txt, "%25", "%")
    txt = VBA.Replace(txt, """, """")
    txt = VBA.Replace(txt, "%2C", ",")
    txt = VBA.Replace(txt, "'", "'")
    UnEncodeURL = txt
End Function

'Private Function xURLEncode(ByVal StringVal As String, _
'                           Optional ByVal SpaceAsPlus As Boolean = False) As String
''!!!!!!!!!!!!!!!!!
'' Not valid for UTF-8
''!!!!!!!!!!!!!!!!!
'    Dim StringLen As Long
'    StringLen = VBA.Len(StringVal)
'
'    Dim Result() As String
'    Dim I As Long
'    Dim CharCode As Integer
'    Dim Char As String
'    Dim Space As String
'
'    If StringLen > 0 Then
'        ReDim Result(StringLen)
'
'        If SpaceAsPlus Then Space = "+" Else Space = "%20"
'
'        For I = 1 To StringLen
'            Char = Mid$(StringVal, I, 1)
'            CharCode = Asc(Char)
'            Select Case CharCode
'                Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
'                    Result(I) = Char
'                Case 32
'                    Result(I) = Space
'                Case 0 To 15
'                    Result(I) = "%0" & Hex(CharCode)
'                Case Else
'                    Result(I) = "%" & Hex(CharCode)
'            End Select
'        Next I
'        xURLEncode = Join(Result, "")
'    End If
'End Function

Public Function RegexExecute(str As String, reg As String, _
                             Optional matchIndex As Long, _
                             Optional subMatchIndex As Long) As String
    On Error GoTo ErrHandl
    Dim regex As Object
    Dim matches As Object
    
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = reg
    regex.Global = Not (matchIndex = 0 And subMatchIndex = 0) 'For efficiency
    If regex.Test(str) Then
        Set matches = regex.Execute(str)
        RegexExecute = matches(matchIndex).SubMatches(subMatchIndex)
        Exit Function
    End If

ErrHandl:
'    RegexExecute = CVErr(xlErrValue)
End Function

If you want to use Google or Microsoft API, here some links:

  • API microsoft: https://sysmod.wordpress.com/2012/01/09/microsoft-translator-vba-code-sample/ ((c) Patrick O’Beirne (@ExcelAnalytics))
  • API Google: https://stackoverflow.com/a/43273425 (requieres module JSonConverter VBA-JSON v2.2.3 (c) Tim Hall – https://github.com/VBA-tools/VBA-JSON

Following a list with the 104 languages supported by Google translator service (in spanish), taken from here.

LANGUAGE SHORT
afrikaans af
albanés sq
alemán de
amárico am
árabe ar
armenio hy
azerí az
bengalí bn
bielorruso be
birmano my
bosnio bs
búlgaro bg
camboyano (o jemer) km
canarés kn
catalán ca
cebuano ce
checo cs
chichewa ny
chino zh
chino tradicional zh
cingalés si
coreano ko
corso co
criollo haitiano ht
croata hr
danés da
eslovaco sk
esloveno sl
español (o castellano) es
esperanto eo
estonio et
euskera eu
finés (o finlandés) fi
francés fr
frisón (o frisio) fy
gaélico escocés gd
galés cy
gallego gl
georgiano ka
griego (moderno) el
guyaratí (o guyaratí) gu
hausa ha
hawuaiano ha
hebreo he
hindi (o hindú) hi
hmong hm
holandes nl
húngaro hu
igbo ig
indonesio id
inglés en
irlandés (o gaélico) ga
islandés is
italiano it
japonés ja
javanés jv
kazajo (o kazajio) kk
kirguís ky
kurdo ku
lao lo
latín la
letón lv
lituano lt
luxemburgués lb
macedonio mk
malayalam ml
malayo ms
malgache (o malagasy) mg
maltés mt
maorí mi
maratí mr
mongol mn
nepalí ne
noruego no
panyabí (o penyabi) pa
pastú (o pashto) ps
persa fa
polaco pl
portugués pt
rumano ro
ruso ru
samoano sm
serbio sr
sesotho st
shona sn
sindhi sd
somalí so
suajili sw
sueco sv
sundanés su
tagalo tl
tailandés th
tamil ta
tayiko tg
telugú te
turco tr
ucraniano uk
urdu ur
uzbeko uz
vietnamita vi
xhosa xh
yídish (o yiddish) yi
yoruba yo
zulú zu

Paste this code where indicated:
trans = RegexExecute(.responseText, “div[^””]*?””ltr””.*?>(.+?)

“)