locked
Translating Activity Names RRS feed

  • Question

  • Here's a fun one...

      I'd like to write a vba routine to translate activity names on demand. It would take the name property of each of the (selected?) activities, find a translation (in my case translating to Chinese...), and post the translation to a custom text field.

      I've seen APIs from Bing, but they're for Visual Studio. I assume there must be a Google Translate API, perhaps using Web Services or some similar technology.

      Any experiences out there?


    Jim

    Monday, May 14, 2012 4:37 AM

Answers

  • Did a little more research and based on that, I'd recommend using the following code.

    The AppID above is linked to the OP's account and is using a deprecated authentication method.  It will work, but if the OP ever kills the account (or too many people use it), it will stop.

    The code below uses a token from the Azure Marketplace to do the same.  Tokens are free up to 2MM characters/month and there're paid subscription over that limit.  Here's the link explaining how to register for a token: http://msdn.microsoft.com/en-us/library/hh454950.aspx

    'Sources of info:
    'http://blogs.msdn.com/b/translation/
    'http://msdn.microsoft.com/en-us/library/hh454950.aspx
    'https://datamarket.azure.com/dataset/1899a118-d202-492c-aa16-ba21c33c06cb
    'http://social.msdn.microsoft.com/Forums/en-US/microsofttranslator/thread/e4c149c4-fefb-48fd-8990-db6a8f0f9045
    'Set the Following References :
    'Microsoft XML, v6.0
    Sub TranslateTaskNames()
    'This macro will translate task names and drop the new values into the Text1 field.
    'Set the authorization token parameters here.  Macro won't work without the appropriate values.
    'See here for instructions on getting set up with the appropriate codes.
    Dim ClientID As String
    Dim ClientSecret As String
    ClientID = "ENTER CLIENT ID"
    ClientSecret = "ENTER CLIENT SECRET"
    'Refer to this page for language codes: http://msdn.microsoft.com/en-us/library/hh456380.aspx
    Dim LanguageFrom As String
    Dim LanguageTo As String
    LanguageFrom = "" 'Set the source language.  Leave blank to auto-detect.
    LanguageTo = "FR"
    'Give the user the option to change the target language
    LanguageTo = InputBox("Enter the target language code:", "Target", LanguageTo)
    'The next section performs the translation
    Dim T As Task
    Dim tName As String
    For Each T In ActiveProject.Tasks
        tName = MicrosoftTranslate(T.Name, LanguageFrom, LanguageTo, ClientID, ClientSecret) 'Translate the Task Name
        tName = Mid(tName, 2, Len(tName) - 2) 'Truncate quotation marks from result set
        T.Text1 = tName
    Next T
    'The next section displays a confirmation box
    Dim tCompleted As String
    tCompleted = MicrosoftTranslate("Translation Completed", LanguageFrom, LanguageTo, ClientID, ClientSecret) 'Translate confirmation message
    tCompleted = Mid(tCompleted, 2, Len(tCompleted) - 2) 'Truncate quotation marks from the result set
    MsgBox "Translation Completed / " & tCompleted, vbOKOnly, "Done"
    End Sub
    Function MicrosoftTranslate(sText As String, LanguageFrom As String, LanguageTo As String, ClientID As String, ClientSecret As String) As String
    'This function calls the Microsoft Translate API
    Dim ID As String
    Dim sURL As String
    Dim oH As MSXML2.XMLHTTP
    Dim sToken As String
       ID = ""    ' Bing appID deprecated in Dec 2011 in favour of Access Token. Use nothing for legacy appID parameter
       sURL = "http://api.microsofttranslator.com/V2/Ajax.svc/Translate?oncomplete=&appId=" & ID _
                & "&from=" & LanguageFrom & "&to=" & LanguageTo & "&text=" & sText
       sToken = GetAccessToken(ClientID, ClientSecret)
       Set oH = CreateObject("MSXML2.XMLHTTP")
       oH.Open "POST", sURL, False
       oH.setRequestHeader "Authorization", "Bearer " & sToken
       oH.send
       MicrosoftTranslate = oH.responseText
       Set oH = Nothing
    End Function
    Function GetAccessToken(ClientID As String, ClientSecret As String) As String
    'This function authenticates against the Azure marketplace to ensure the user is authorized to use the app.
    Dim webRequest As MSXML2.ServerXMLHTTP
    Set webRequest = CreateObject("MSXML2.ServerXMLHTTP")
    Dim URI As String
    URI = "https://datamarket.accesscontrol.windows.net/v2/OAuth2-13"
    Dim sRequest As String
    sRequest = "grant_type=client_credentials" & _
          "&client_id=" & ClientID & _
          "&client_secret=" & URLEncode(ClientSecret) & _
          "&scope=http://api.microsofttranslator.com"
    Dim mtToken As String
    Set webRequest = New ServerXMLHTTP
    webRequest.Open "POST", URI, False
    webRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    webRequest.send sRequest
    mtToken = webRequest.responseText
    Set webRequest = Nothing
    'Debug.Print mtToken
    Dim arr As Variant, header As String
    header = "{""access_token"":"""
    arr = Split(mtToken, ",")
    GetAccessToken = Mid$(arr(0), Len(header) + 1, Len(arr(0)) - Len(header) - 1)
    End Function
    Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
    'This function modifies the text to properly work in a URL.
    Dim StringLen As Long
     StringLen = Len(StringVal)
     If StringLen > 0 Then
       ReDim result(StringLen) As String
       Dim i As Long, CharCode As Integer
       Dim Char As String, Space As String
       If SpaceAsPlus Then Space = "+" Else Space = "%20"
       For i = 1 To StringLen
          Char = Mid$(StringVal, i, 1)
          CharCode = Asc(Char)
          Select Case CharCode
          Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Char
          Case 32
          result(i) = Space
          Case 0 To 15
          result(i) = "%0" & Hex(CharCode)
          Case Else
          result(i) = "%" & Hex(CharCode)
          End Select
       Next i
       URLEncode = Join(result, "")
    End If
    End Function


    Andrew Lavinsky [MVP] Blog: http://azlav.umtblog.com Twitter: @alavinsky

    Wednesday, May 16, 2012 3:32 PM

All replies

  • Hi Jim,

    Not specifically with MS project but tried with Office 2007 Translator usingt the Microsoft Translator Web Service: <tt>http://www.windowslivetranslator.com/officetrans/register.asmx</tt>

    MSDN blogs
    http://blogs.msdn.com/b/translation/archive/2009/04/16/download-the-microsoft-translator-installer-for-microsoft-office.aspx

    http://blogs.msdn.com/b/translation/archive/2008/08/06/office-document-translation.aspx


    Thanks, Amit Khare |EPM Consultant| Blog: http://amitkhare82.blogspot.com http://www.linkedin.com/in/amitkhare82

    Monday, May 14, 2012 8:35 AM
  • I looked into Google APIs recently for another project.
    https://code.google.com/apis/console/

    While a lot of the APIS give you limited usage for free, I spotted that the Google Translate API doesn't give any free use, and seems in be charged per character.
    https://developers.google.com/translate/v2/pricing

    Monday, May 14, 2012 12:32 PM
  • If you use a lot of technical jargon, you may end up with gibberish in the task column.  I'd take a look at adding a custom column, then perhaps exploring the use of a COTS translation program and/or college intern to come up with standard task name translations.

    For instance, export to Excel, do a lot of Find/Replace in Excel and then reimport into your custom column.  Better yet, if you have a lot of repetition, code each task, and then map the codes to a specific translation in a table or Access/SQL database.

    FWIW, then you can create specific views and change the column headers to the local Chinese headers.


    Andrew Lavinsky [MVP] Blog: http://azlav.umtblog.com Twitter: @alavinsky

    Monday, May 14, 2012 1:20 PM
  • Andrew, you're absolutely right about the technical jargon. When I translate the Chinese I do have, I get translations for "duct" as "wind tunnel" for example. My plan was to set aside a custom text field for the Chinese translation, then a flag field to indicate the name has been manually translated (and should not be re-translated.) That way, I can flag any manual translations as they come up and prevent backward motion (imagine backward motion on a schedule....lol.)

    I offered my users the chance to do the translation for me -- I'd send them a workbook and import the results. I don't get a strong feeling they're planning to do that. But I still feel an obligation to have the schedule readable by them -- after all, it's their country!

    I've found a routine to do this using Bing (Microsoft) Translate APIs. It works except the result is "??" instead of the Chinese characters. This suggests some sort of "code" problem as opposed to an error. I'll post the code. Maybe someone will recognize the problem. Meanwhile, once I get it going, I suspect I may have my solution.

    Sub bingTranslate()
     languageFrom = "en": languageTo = "zh-chs": sText = "Thank you"
     ID = "708BEDCB01828123DC7B6C6A6AB12EF82DFBB611"
    sURL = "http://api.microsofttranslator.com/V2/Ajax.svc/Translate?oncomplete=&appId=" & ID + "&from=" & languageFrom + "&to=" & languageTo & "&text=" & sText
      Set oH = CreateObject("Microsoft.XMLHTTP")
      oH.Open "get", sURL, False
      oH.sEnd
      sresult = oH.responseText
      MsgBox oH.responseText
      Debug.Print sresult
    End Sub
    Output is: "??"


    Jim

    Monday, May 14, 2012 3:36 PM
  • I have to admit...the challenge kind of intrigued me.  I tried it with the following code and it worked.  I think your issue was that it was returning the value embedded in quotation marks.  I used a Text field and then added code to remove the quotation marks.

    It now translates into the Task Text 1 field.  Chinese even appears correct with some limited testing.  I'll have to try it on a large project to see what it looks like.

    Sub bingTranslate()

        Dim T As Task
       
        For Each T In ActiveProject.Tasks

     languageFrom = "en": languageTo = "zh-chs": sText = T.Name
     ID = "708BEDCB01828123DC7B6C6A6AB12EF82DFBB611"
    sURL = "http://api.microsofttranslator.com/V2/Ajax.svc/Translate?oncomplete=&appId=" & ID + "&from=" & languageFrom + "&to=" & languageTo & "&text=" & sText
      Set OH = CreateObject("Microsoft.XMLHTTP")
      OH.Open "get", sURL, False
      OH.sEnd
      T.Text1 = Mid(OH.ResponseText, 2, Len(OH.ResponseText) - 2)
      'sresult = oH.responseText
      'MsgBox oH.responseText
      'Debug.Print sresult
     
      Next T
     
     
    End Sub


    Andrew Lavinsky [MVP] Blog: http://azlav.umtblog.com Twitter: @alavinsky

    • Marked as answer by JimS-Indy Monday, May 14, 2012 4:08 PM
    • Unmarked as answer by Andrew Lavinsky Wednesday, May 16, 2012 3:33 PM
    Monday, May 14, 2012 3:49 PM
  • I knew it would intrigue someone, though I expected it to be Rod Gill....lol

    Thank you for your modification!


    Jim

    Monday, May 14, 2012 4:09 PM
  • Quick question - this trick is so neat, it deserves to be immortalized in a blog post for future reference.  Would you be ok if I blogged it up - giving you full credits, of course?  (Feel free to respond via LinkedIn as well)

    Andrew Lavinsky [MVP] Blog: http://azlav.umtblog.com Twitter: @alavinsky

    Monday, May 14, 2012 6:57 PM
  • Getting on a 14 hour flight in a couple hours. I have no problem with your using my post, but we need to credit the original author. I'll try to figure out where I got it...Here's the link

    Simple Translator Code question


    Jim


    • Edited by JimS-Indy Tuesday, May 15, 2012 12:25 AM Link
    Tuesday, May 15, 2012 12:21 AM
  • Did a little more research and based on that, I'd recommend using the following code.

    The AppID above is linked to the OP's account and is using a deprecated authentication method.  It will work, but if the OP ever kills the account (or too many people use it), it will stop.

    The code below uses a token from the Azure Marketplace to do the same.  Tokens are free up to 2MM characters/month and there're paid subscription over that limit.  Here's the link explaining how to register for a token: http://msdn.microsoft.com/en-us/library/hh454950.aspx

    'Sources of info:
    'http://blogs.msdn.com/b/translation/
    'http://msdn.microsoft.com/en-us/library/hh454950.aspx
    'https://datamarket.azure.com/dataset/1899a118-d202-492c-aa16-ba21c33c06cb
    'http://social.msdn.microsoft.com/Forums/en-US/microsofttranslator/thread/e4c149c4-fefb-48fd-8990-db6a8f0f9045
    'Set the Following References :
    'Microsoft XML, v6.0
    Sub TranslateTaskNames()
    'This macro will translate task names and drop the new values into the Text1 field.
    'Set the authorization token parameters here.  Macro won't work without the appropriate values.
    'See here for instructions on getting set up with the appropriate codes.
    Dim ClientID As String
    Dim ClientSecret As String
    ClientID = "ENTER CLIENT ID"
    ClientSecret = "ENTER CLIENT SECRET"
    'Refer to this page for language codes: http://msdn.microsoft.com/en-us/library/hh456380.aspx
    Dim LanguageFrom As String
    Dim LanguageTo As String
    LanguageFrom = "" 'Set the source language.  Leave blank to auto-detect.
    LanguageTo = "FR"
    'Give the user the option to change the target language
    LanguageTo = InputBox("Enter the target language code:", "Target", LanguageTo)
    'The next section performs the translation
    Dim T As Task
    Dim tName As String
    For Each T In ActiveProject.Tasks
        tName = MicrosoftTranslate(T.Name, LanguageFrom, LanguageTo, ClientID, ClientSecret) 'Translate the Task Name
        tName = Mid(tName, 2, Len(tName) - 2) 'Truncate quotation marks from result set
        T.Text1 = tName
    Next T
    'The next section displays a confirmation box
    Dim tCompleted As String
    tCompleted = MicrosoftTranslate("Translation Completed", LanguageFrom, LanguageTo, ClientID, ClientSecret) 'Translate confirmation message
    tCompleted = Mid(tCompleted, 2, Len(tCompleted) - 2) 'Truncate quotation marks from the result set
    MsgBox "Translation Completed / " & tCompleted, vbOKOnly, "Done"
    End Sub
    Function MicrosoftTranslate(sText As String, LanguageFrom As String, LanguageTo As String, ClientID As String, ClientSecret As String) As String
    'This function calls the Microsoft Translate API
    Dim ID As String
    Dim sURL As String
    Dim oH As MSXML2.XMLHTTP
    Dim sToken As String
       ID = ""    ' Bing appID deprecated in Dec 2011 in favour of Access Token. Use nothing for legacy appID parameter
       sURL = "http://api.microsofttranslator.com/V2/Ajax.svc/Translate?oncomplete=&appId=" & ID _
                & "&from=" & LanguageFrom & "&to=" & LanguageTo & "&text=" & sText
       sToken = GetAccessToken(ClientID, ClientSecret)
       Set oH = CreateObject("MSXML2.XMLHTTP")
       oH.Open "POST", sURL, False
       oH.setRequestHeader "Authorization", "Bearer " & sToken
       oH.send
       MicrosoftTranslate = oH.responseText
       Set oH = Nothing
    End Function
    Function GetAccessToken(ClientID As String, ClientSecret As String) As String
    'This function authenticates against the Azure marketplace to ensure the user is authorized to use the app.
    Dim webRequest As MSXML2.ServerXMLHTTP
    Set webRequest = CreateObject("MSXML2.ServerXMLHTTP")
    Dim URI As String
    URI = "https://datamarket.accesscontrol.windows.net/v2/OAuth2-13"
    Dim sRequest As String
    sRequest = "grant_type=client_credentials" & _
          "&client_id=" & ClientID & _
          "&client_secret=" & URLEncode(ClientSecret) & _
          "&scope=http://api.microsofttranslator.com"
    Dim mtToken As String
    Set webRequest = New ServerXMLHTTP
    webRequest.Open "POST", URI, False
    webRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    webRequest.send sRequest
    mtToken = webRequest.responseText
    Set webRequest = Nothing
    'Debug.Print mtToken
    Dim arr As Variant, header As String
    header = "{""access_token"":"""
    arr = Split(mtToken, ",")
    GetAccessToken = Mid$(arr(0), Len(header) + 1, Len(arr(0)) - Len(header) - 1)
    End Function
    Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
    'This function modifies the text to properly work in a URL.
    Dim StringLen As Long
     StringLen = Len(StringVal)
     If StringLen > 0 Then
       ReDim result(StringLen) As String
       Dim i As Long, CharCode As Integer
       Dim Char As String, Space As String
       If SpaceAsPlus Then Space = "+" Else Space = "%20"
       For i = 1 To StringLen
          Char = Mid$(StringVal, i, 1)
          CharCode = Asc(Char)
          Select Case CharCode
          Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Char
          Case 32
          result(i) = Space
          Case 0 To 15
          result(i) = "%0" & Hex(CharCode)
          Case Else
          result(i) = "%" & Hex(CharCode)
          End Select
       Next i
       URLEncode = Join(result, "")
    End If
    End Function


    Andrew Lavinsky [MVP] Blog: http://azlav.umtblog.com Twitter: @alavinsky

    Wednesday, May 16, 2012 3:32 PM
  • I will load that up this week. Thank you so much! I was worried when I found out the other code was deprecated, and the only functional MS Translate code to be found used .net... Thank you!

    I signed up for an Azure account. Where do I get the "ID" and "Secret" codes. I found an ID in my Azure account, but no "secret code"....


    Jim


    • Edited by JimS-Indy Wednesday, May 16, 2012 5:49 PM last line
    Wednesday, May 16, 2012 5:36 PM
  • You have the ID sounds like.  The secret is from here:

    https://datamarket.azure.com/developer/applications/

    You have to "Register" your app - whatever that means.  As far as I can tell, you're just telling them the name of your app, i.e. MPP VBA Translator, and they're marrying it to a GUID....


    Andrew Lavinsky [MVP] Blog: http://azlav.umtblog.com Twitter: @alavinsky

    Wednesday, May 16, 2012 9:20 PM