I have a worksheet that contains random words and phrases in several non-English languages, plus dates and numbers. The "Translate" sub in this code which I found on the web drives the process of using Google Translate to translate the words to English. It works great most of the time but once in a while the code will display the "Can not translate" message for one or more of the words or phrases even though it translated them in a previous run. Is it because the website is busy? How can I avoid that? BTW the translateFrom = "auto" tells Google Translate to detect the language in the cell and translateTo = "en" tells it to translate it to English.
Code:
Sub Translate()
Dim cel As Range
With ActiveSheet
For Each cel In .UsedRange.Cells
If Not IsEmpty(cel) Then
TranslateCell cel
End If
Next
End With
End Sub
Private Sub TranslateCell(cel As Range)
Dim getParam As String, trans As String, translateFrom As String, translateTo As String
Dim objHTTP As Object
Dim URL As String
translateFrom = "auto"
translateTo = "en"
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
getParam = ConvertToGet(cel.Value)
URL = "https://translate.google.pl/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>")
cel.Value = Clean(trans)
Else
MsgBox ("Error: Can not translate '" & cel & "'")
Debug.Print "Could not translate '" & cel & "'"
End If
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, """, """")
val = Replace(val, "%2C", ",")
val = Replace(val, "'", "'")
Clean = val
End Function
Public Function RegexExecute(str As String, reg As String, _
Optional matchIndex As Long, _
Optional subMatchIndex As Long) As String
Dim regex As Object
Dim matches
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