Excel的谷歌翻译功能不起作用

Question

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

我多年来一直工作良好，但由于某种原因突然停止工作。

知道为什么吗？我正在使用 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

Answer 1

我的猜测是 Google 已经更改了响应 HTML，并且您的代码正在寻找翻译的 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