Google Excel 的翻译功能不工作

Google Translate function for Excel not working

我有这个功能可以翻译所有选定的单元格 Google 翻译。

多年来我工作得很好,但由于某种原因突然停止工作。

知道为什么吗?我正在使用 Excel 2010.

提前致谢

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

我的猜测是 Google 已经更改了响应 HTML 并且您的代码正在寻找 t运行slation 的 DIV 不再是其中的一部分响应格式。

我 运行 并得到了一个有效的响应页面。我更改了您的代码以使用此“新”响应。

试试这个:

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