Translation services using Bing API

Bing has an API for, among other things, translating text from one language to another.
Many of you are familiar with the approach found at Translating text, or perhaps your searching has brought you to Google translate by Internet Explorer Automation, a hellacious-to-read example. Here's my entry.

You can Hear In Your Language in Office 2010, but what about those of us who don't have it yet, don't want it, or want to hear translations another way?
First, the obligatory ancillary functions used by each of the main functions below. Paste the following code section into a standard module. Typically I put these into their own module (called "Utilities").

Function GetChildNodes(node As Object) As Object
' returns child nodes for a given MSXML2.IXMLDOMNode
 Set GetChildNodes = node.childNodes
End Function

Function CreateXMLFile(fileName As String, contents As String) As String
' creates XML file from string contents

Dim tempFile As String
Dim nextFileNum As Long

  nextFileNum = FreeFile

  tempFile = fileName

  Open tempFile For Output As #nextFileNum
  Print #nextFileNum, FixAngleBrackets(contents)
  Close #nextFileNum

  CreateXMLFile = tempFile
End Function

Function GetRootNode(xmlDoc As Object) As Object
' returns root node
 Set GetRootNode = xmlDoc.documentElement
End Function

Function LoadError(xmlDoc As Object) As Boolean
' checks if a xml file load error occurred
 LoadError = (xmlDoc.parseError.errorCode <> 0)
End Function

Function ClearCache(Optional fileExtension As String = "xml")
' deletes stored xml files from temp folder
Dim filesToDelete As String
  filesToDelete = environ("temp") & "\*." & fileExtension

  Kill filesToDelete
End Function

Function FixAngleBrackets(textString As String) As String
  FixAngleBrackets = Replace(Replace(textString, "&lt;", "<"), "&gt;", ">")
End Function

These functions have been seen before (here's one place: Periodic Table of Elements fetching with XMLHTTP), so I won't go into detail about them.
You will need an API key (called an appId by Bing) in order to access these methods. I've left my API key out of the following code samples, go get your own!
Note that these are only some of the available translation methods; visit the Bing API for all of them.

Detect Language

The following function will return the language locale of a given input string. Just pass in your API key and the text you want to interpret. I haven't tested this function thoroughly but I think it can understand any language listed in the languageCode enum.

Function DetectLanguage(appID As String, _
    textToDetect As String) As String

Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode

  Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

  xml.Open "GET", _
    "http://api.microsofttranslator.com/V2/Http.svc/Detect?appId=" & _
    appID & "&text=" & textToDetect, False
  xml.Send

  result = xml.responseText

  ' create XML file from result
 tempFile = environ("temp") & "\detect.xml"
  Call CreateXMLFile(tempFile, result)

  ' open XML file
 Set xmlDoc = CreateObject("MSXML2.DOMDocument")

  With xmlDoc
    .async = False
    .validateOnParse = False
    .Load tempFile
  End With

  ' check that the XML doc loaded
 If LoadError(xmlDoc) Then
    Exit Function
  End If

  ' get root node
 Set xmlDocRoot = GetRootNode(xmlDoc)
  ' only one node, so we can access result directly
 DetectLanguage = xmlDocRoot.Text

End Function

Sample usage

Sub TestDetect()

Dim appID As String
Dim textToDetect As String

  appID = "your app ID here"
  textToDetect = "hello world"

    Debug.Print DetectLanguage(appID, textToDetect)

End Sub

Get Languages for Speaking

The Bing API can actually return audio clips of spoken words for you. This function will tell you what languages it can speak. This list is unlikely to change, but you can tell it to requery the API anyway by passing True as the second parameter.

Function GetLanguagesForSpeak(appID As String, _
                              Optional forceRequery As Boolean = False) As String()

Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim languages As Object ' MSXML2.IXMLDOMNodeList
Dim i As Long
Dim tempString() As String

  tempFile = environ("temp") & "\GetLanguagesForSpeak.xml"

  ' requery website if file doesn't already exist, or
 ' we want a new web query anyway
 If Len(Dir(tempFile)) = 0 Or forceRequery Then

    Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

    xml.Open "GET", _
    "http://api.microsofttranslator.com/V2/Http.svc/GetLanguagesForSpeak?appID=" & _
    appID, False
    xml.Send

    result = xml.responseText

    ' create XML file from result
   Call CreateXMLFile(tempFile, result)

  End If

  ' open XML file
 Set xmlDoc = CreateObject("MSXML2.DOMDocument")

  With xmlDoc
    .async = False
    .validateOnParse = False
    .Load tempFile
  End With

  ' check that the XML doc loaded
 If LoadError(xmlDoc) Then
    Exit Function
  End If

  ' get root node
 Set xmlDocRoot = GetRootNode(xmlDoc)
  ' get first level nodes
 Set languages = GetChildNodes(xmlDocRoot)

  ' size the array
 ReDim tempString(1 To languages.Length)

  For i = 1 To languages.Length
    tempString(i) = languages.Item(i - 1).nodeTypedValue
  Next i

  GetLanguagesForSpeak = tempString
End Function

Sample usage

Sub TestGetLanguagesForSpeak()

Dim appID As String
Dim tempString() As String
Dim i As Long

  appID = "your app ID here"

  tempString = GetLanguagesForSpeak(appID)
 
  For i = LBound(tempString) To UBound(tempString)
    Debug.Print tempString(i)
  Next i

End Sub

Get Languages For Translation

This function will return all the language locales that the API can translate to and from. Typically this doesn't change very often (which is why I've hardcoded the list in the Enum) but you can force a requery if needed.

Function GetLanguagesForTranslate(appID As String, _
                                  Optional forceRequery As Boolean = False) As String()

Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim languages As Object ' MSXML2.IXMLDOMNodeList
Dim i As Long
Dim tempString() As String

  tempFile = environ("temp") & "\GetLanguagesForTranslate.xml"

  ' requery website if file doesn't already exist, or
 ' we want a new web query anyway
 If Len(Dir(tempFile)) = 0 Or forceRequery Then

    Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

    xml.Open "GET", _
    "http://api.microsofttranslator.com/V2/Http.svc/GetLanguagesForTranslate?appID=" & _
    appID, False
    xml.Send

    result = xml.responseText

    ' create XML file from result
   Call CreateXMLFile(tempFile, result)

  End If

  ' open XML file
 Set xmlDoc = CreateObject("MSXML2.DOMDocument")

  With xmlDoc
    .async = False
    .validateOnParse = False
    .Load tempFile
  End With

  ' check that the XML doc loaded
 If LoadError(xmlDoc) Then
    Exit Function
  End If

  ' get root node
 Set xmlDocRoot = GetRootNode(xmlDoc)
  ' get first level nodes
 Set languages = GetChildNodes(xmlDocRoot)

  ' size the array
 ReDim tempString(1 To languages.Length)

  For i = 1 To languages.Length
    tempString(i) = languages.Item(i - 1).nodeTypedValue
  Next i

  GetLanguagesForTranslate = tempString
End Function

Sample usage

Sub TestGetLanguages()

Dim appID As String
Dim tempString() As String
Dim i As Long

  appID = "your app ID here"

  tempString = GetLanguagesForTranslate(appID)

  For i = LBound(tempString) To UBound(tempString)
    Debug.Print tempString(i)
  Next i

End Sub

Translate Function

Hopefully you've been waiting for this. Here's the function that translates from one language to another. To find out the available languages, run GetLanguagesForTranslate first.

Function Translate(appID As String, textToTranslate As String, _
                   fromLanguageCode As languageCode, _
                   toLanguageCode As languageCode) As String

Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim fromLang As String
Dim toLang As String

  fromLang = GetLanguageCode(fromLanguageCode)
  toLang = GetLanguageCode(toLanguageCode)

  Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

  xml.Open "GET", _
    "http://api.microsofttranslator.com/V2/Http.svc/Translate?appID=" & _
    appID & "&text=" & textToTranslate & "&from=" & fromLang & "&to=" & _
    toLang, False
  xml.Send

  result = xml.responseText

  ' create XML file from result
 tempFile = environ("temp") & "\" & textToTranslate & ".xml"
  Call CreateXMLFile(tempFile, result)

  ' open XML file
 Set xmlDoc = CreateObject("MSXML2.DOMDocument")

  With xmlDoc
    .async = False
    .validateOnParse = False
    .Load tempFile
  End With

  ' check that the XML doc loaded
 If LoadError(xmlDoc) Then
    Exit Function
  End If

  ' get root node
 Set xmlDocRoot = GetRootNode(xmlDoc)
  ' get result directly
 Translate = xmlDocRoot.Text

End Function

Sample usage

Sub TestTranslate()

Dim appID As String

  appID = "your app ID here"

  Debug.Print Translate(appID, textToDetect, en, fr)

End Sub

languageCode Enum

This enum is used by the Translate function. Paste it at the top of a standard module, or put it into its own module. The GetLanguageCode function is used to convert the constant to a String for the API.

Public Enum languageCode
  ar
  bg
  zhCHS
  zhCHT
  cs
  da
  nl
  en
  ht
  fi
  fr
  de
  el
  he
  hu
  it
  ja
  ko
  lt
  no
  pl
  pt
  ro
  ru
  sk
  sl
  es
  sv
  th
  tr
End Enum

Function GetLanguageCode(lc As languageCode) As String

  Select Case lc
    Case 0
      GetLanguageCode = "ar"
    Case 1
      GetLanguageCode = "bg"
    Case 2
      GetLanguageCode = "zh-CHS"
    Case 3
      GetLanguageCode = "zh-CHT"
    Case 4
      GetLanguageCode = "cs"
    Case 5
      GetLanguageCode = "da"
    Case 6
      GetLanguageCode = "nl"
    Case 7
      GetLanguageCode = "en"
    Case 8
      GetLanguageCode = "ht"
    Case 9
      GetLanguageCode = "fi"
    Case 10
      GetLanguageCode = "fr"
    Case 11
      GetLanguageCode = "de"
    Case 12
      GetLanguageCode = "el"
    Case 13
      GetLanguageCode = "he"
    Case 14
      GetLanguageCode = "hu"
    Case 15
      GetLanguageCode = "it"
    Case 16
      GetLanguageCode = "ja"
    Case 17
      GetLanguageCode = "ko"
    Case 18
      GetLanguageCode = "lt"
    Case 19
      GetLanguageCode = "no"
    Case 20
      GetLanguageCode = "pl"
    Case 21
      GetLanguageCode = "pt"
    Case 22
      GetLanguageCode = "ro"
    Case 23
      GetLanguageCode = "ru"
    Case 24
      GetLanguageCode = "sk"
    Case 25
      GetLanguageCode = "sl"
    Case 26
      GetLanguageCode = "es"
    Case 27
      GetLanguageCode = "sv"
    Case 28
      GetLanguageCode = "th"
    Case 29
      GetLanguageCode = "tr"
  End Select
End Function Source: http://www.codeforexcelandoutlook.com