MS Excel VBA script to translate worksheets using the google translate API

UPDATE: I've made and Excel Add-In, that you can download here. Add it in to your worksheet and type Control+Shift+T to start the macro. I'll try to make a youtube video to demonstrate.

UPDATE #2: Here is a YouTube video to show how to download and install the add-in.

A while ago I wrote some code in Perl to translate excel sheets using google translate while preserving the formatting. That way was long, unreliable, complicated, etc. Here is a better solution.

Put the following MS Excel VBA macro code into your personal workbook, and create a shortcut to it (I use Ctrl+shift+t). It uses the google translate API. It will translate all non-empty, non-numeric cells in the active worksheet, placing the translation into a new worksheet, with the original formatting. It will place the original of numeric cells (not translated) into the new worksheet. The new worksheet will be the name of the old worksheet, with an underscore and the two letter language code appended onto it. If a worksheet with that name already exists, it will be deleted.

You will have to specify the following in a dialog box that will pop up when you run the Macro (or just in the code - I don't know how to paste the code for the userform here):
1. your google API key. The google translate API is not free, right now it is $20 per 1M characters
2. two letter language code for the source language
3. two letter language code for the destination language

(for 2 and 3, you have to use the language codes that the google translate API supports. See https://developers.google.com/translate/)

Maybe I'll modify this one day to use autodetect for the language, so that you can translate multiple languages on the same worksheet.

Feedback is always appreciated. Good luck!

Sub TranslateWorsheet()

    ' I got the URL encoding function here: http://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba
    ' To run this script, you need to add "Microsoft Script Control" as reference (Tools -> References in the VB Editor)

    ' Step 1: Create a new worksheet: existing worksheetname_2lettertargetlanguagecode
    ' Step 2: In the current sheet, loop through all non-empty cells
    '       a) send the REST request to API to translate the contents of the cell if it is non-numeric, otherwise paste the original cell contents
    '       b) put the translated contents in the corresponding cell of the new worksheet
    '       c) copy also the formatting of the cell

    Dim destinationWorksheetName As String
    Dim sourceWorksheetName As String
    Dim cellContent As String
    Dim cellAddress As String
    Dim sourceWorksheet As Worksheet
    Dim destinationWorksheet As Worksheet
    
    Dim ScriptEngine As ScriptControl
    Set ScriptEngine = New ScriptControl
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function encode(str) {return encodeURIComponent(str);}"
    
    ' use regualr expression to get the translation
    Dim RE As Object
    Set RE = CreateObject("VBScript.RegExp")
    RE.Pattern = "\[\s*{\s*""translatedText"": ""(.*)""\s}*"
    RE.IgnoreCase = False
    RE.Global = False
    RE.MultiLine = True
    Dim testResult As Boolean
   
    ' send the translation request
    Dim REMatches As Object
    Dim translateD As String
    Dim sourceString As String
    Dim K As String
    Dim URL As String
    Dim encodedSourceString As String
    Dim sourceLanguage As String
    Dim destinationLanguage As String
    Set sourceWorksheet = ActiveSheet
    sourceWorksheetName = ActiveSheet.Name
   
    ' sourceString = "Hello World"
    destinationLanguage = "EN"
    sourceLanguage = "RU"
    K = InputBox(prompt:="Please enter your Google Translate API key", Title:="Google Translate API Key Required: For more info, see https://developers.google.com/translate/v2/getting_started")

    'obTranslateOptions.Show
    'sourceLanguage = obTranslateOptions.obSourceLanguage.Text
    'destinationLanguage = obTranslateOptions.obDestinationLanguage.Text
    'K = obTranslateOptions.obKey.Text

    'Debug.Print "K=" & K
    'Debug.Print "sourceLanguage=" & sourceLanguage
    'Debug.Print "destinationLanguage=" & destinationLanguage
   
    ' Unload obTranslateOptions
   
    ' If a worksheet of this name in this workbook already exist, then delete it
    destinationWorksheetName = sourceWorksheetName & "_" & destinationLanguage
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets(destinationWorksheetName).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
   
    ' Prepare to send the request
    Dim objHTTP As Variant
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Dim responseT As String
      
    ' copy active worksheet, clear contents of the copy
    ActiveWorkbook.ActiveSheet.Copy after:=ActiveWorkbook.ActiveSheet
    ActiveSheet.Name = destinationWorksheetName
    ActiveSheet.Cells.ClearContents
    Set destinationWorksheet = ActiveSheet
   
    sourceWorksheet.Activate
    ' loop through all non-empty cells or all selected cells
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange.Cells
   
        'Debug.Print cell.Address
        cellAddress = cell.Address
        sourceString = cell.Value
        'Debug.Print "sourceString:" & sourceString
   
        ' do only for non-numeric cells
        If (IsNumeric(cell.Value) = False) Then
               
            ' encode the source text
            encodedSourceString = ScriptEngine.Run("encode", sourceString)
            ' prepare and send the request
            URL = "https://www.googleapis.com/language/translate/v2?key=" & K & "&source=" & sourceLanguage & "&target=" & destinationLanguage & "&q=" & encodedSourceString
            objHTTP.Open "GET", URL, False
            objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
            objHTTP.send ("")
            responseT = objHTTP.ResponseText
            ' Debug.Print "responseT:" & responseT
       
            ' pull the translation from the response to the request
            If (RE.Test(responseT) = True) Then
                'Debug.Print "re.test is true"
                Set REMatches = RE.Execute(responseT)
                translateD = REMatches.Item(0).SubMatches.Item(0)
                'Debug.Print "translateD:" & translateD
            Else
                'Debug.Print "re.test is false"
            End If
       
            destinationWorksheet.Range(cellAddress).Value = translateD
        Else
            destinationWorksheet.Range(cellAddress).Value = cell.Value
        End If
    Next
   
End Sub