Google Translate function for Excel not working
Asked Answered
L

1

1

I have this function that translates all selected cells with Google Translate.

I was working fine for years but it suddenly stopped to work for some reason.

Any idea why? I'm using Excel 2010.

Thanks in advance

Sub TranslateCell()
        Dim getParam As String, trans As String, translateFrom As String, translateTo As String
        translateFrom = "en"
        translateTo = "fr"
        Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
        Dim r As Range, cell As Range
        Set cell = Selection
        For Each cell In Selection.Cells
            getParam = ConvertToGet(cell.Value)
            URL = "https://translate.google.fr/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
            objHTTP.Open "GET", URL, False
            objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
            objHTTP.send ("")
            If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
                trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
                cell.Value = Clean(trans)
            Else
                MsgBox ("Error")
            End If
        Next cell
    End Sub
'----Used functions----
Function ConvertToGet(val As String)
    val = Replace(val, " ", "+")
    val = Replace(val, vbNewLine, "+")
    val = Replace(val, "(", "%28")
    val = Replace(val, ")", "%29")
    ConvertToGet = val
End Function
Function Clean(val As String)
    val = Replace(val, "&quot;", """")
    val = Replace(val, "%2C", ",")
    val = Replace(val, "&#39;", "'")
    Clean = val
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
    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
Loan answered 22/12, 2020 at 20:6 Comment(4)
Please include the code for ConvertToGet() and RegexExecute() and Clean().Wurtz
Also, what happens? You say it doesn't work... but what happens? Does it produce an error... on which line?Wurtz
Hi Excel hero. I just get the error message called by the Else statement.Loan
Have you checked to see what objHTTP.responseText is when you reach that if statement? Does it still include div dir="ltr"? I'm guessing not, so that would mean that google changed something that you now have to figure out.Outfight
W
2

My guess is that Google has changed the response HTML and the DIV that your code is looking for for the translation is no longer part of the response format.

I ran and got a valid response page. I changed your code to work with this "new" response.

Try this:

Sub TranslateCell()
    Dim objHTTP As Object, URL$
    Dim getParam As String, trans As String, translateFrom As String, translateTo As String
    translateFrom = "en"
    translateTo = "fr"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Dim r As Range, cell As Range
    Set cell = Selection
    For Each cell In Selection.Cells
        getParam = ConvertToGet(cell.Value)
        URL = "https://translate.google.fr/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
        objHTTP.Open "GET", URL, False
        objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        objHTTP.Send
        'If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
        If InStr(objHTTP.responseText, "<div class=""result-container"">") Then
            'trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
            trans = RegexExecute(objHTTP.responseText, "div[^""]*?""result-container"".*?>(.+?)<\/div>")
            cell.Value = Clean(trans)
        Else
            MsgBox "Error"
        End If
    Next cell
End Sub
Wurtz answered 22/12, 2020 at 21:25 Comment(3)
That was it! Now it's working properly again. Thank a lot, true Excel Hero indeed :)Loan
@Loan I found your question interesting and decided to create a User Defined Function based on this. I answered an ancient question here from 2013 just now using the UDF. You may find it useful: https://mcmap.net/q/756985/-translate-text-using-vbaWurtz
Glad to hear that! I'll definitely make good use of that too. Thanks again :)Loan

© 2022 - 2024 — McMap. All rights reserved.