I know what you’re all thinking. Project 2010 is fantastic – and we can’t wait till we get to see the next version. The only problem is that there’s this one critical function that Microsoft really needs to bake into the product. You see, they really need to add a button that will automatically translate my schedule into Romanian.
Now, I don’t think we’ll see that quite baked into the product in the near future, but in this post, I’ll show you how to quickly add a bit of VBA that ties into the Microsoft Translator API to automatically translate your project schedule into Romanian – or 36 other supported languages ranging from Hmong Daw to Haitian Creole. (Although, it still doesn’t support Mongol unfortunately. I guess I’ll have to wait a bit for that.)
I know that I am a bit stuck in a VBA rut, but every now and then, I run into a trick that’s so cool, it’s worth blogging about. In this case, I can’t really take much credit. JimS, one of the users on the forums came up with this code to automatically translate task names from one language to another. (Although as far as I can tell, the code originally derived from a post by Travis McGee back in 2010.)
The magic is done through the use of a bit of VBA code – that then calls the Microsoft Translation API, and drops the results into the Text1 field.
I had to update the code a bit for this blog as it appears the original code was using an older authentication form that has now been deprecated. Hence, I would definitely not recommend using the older Bing AppID authentication method that is floating around on the Web and instead implement the code below which authenticates against the Azure marketplace using an authorization token.
Registering with the Azure Marketplace
The first step though is to get two parameters: the ClientID and the ClientSecret from your free account on the Azure Marketplace. Check here for guidance on getting those. These parameters link the application to your user account – so for example, you could use the free version which is limited to 2 million characters/month, or pay a bit more to get more volume.
The VBA
Hat tip to this post for the guidance on adding the functionality to get the Authorization Token.
You’ll need to enter your personal Client ID and the Client Secret into the code to get it to function. All the configuration parameters are grouped in the first function.
'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 YOUR CLIENT ID HERE" ClientSecret = "ENTER YOUR CLIENT SECRET HERE" '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
Set the source and/or target language per the options here.
Here’s the same exercise from English to Spanish. I don’t make any claims about the quality of the translation, but overall, it doesn’t seem like a bad start.
Kind of wish I’d had something like this back in the late 90s when I had to figure out a system to translate Fluke testing reports into English.