Using Azure Translator in an Excal VBA macro

Question

For over 5 years now I have used this code to convert user input English text into French or German in an Excel VBA macro. That was with Microsoft Azure Marketplace and, since my usage was minimal, it was free.

Function MicrosoftTranslate(sText As String, Optional sLanguageFrom As String = "", Optional sLanguageTo As String = "en") As String
Dim sRequest As String, sResponseText As String
   sRequest = "Translate?from=" & sLanguageFrom & "&to=" & sLanguageTo & "&text=" & sText
   sResponseText = MSHttpRequest(sRequest)
   'Debug.Print sResponseText
   MicrosoftTranslate = StringFromXML(sResponseText)
End Function

Function MicrosoftTranslatorDetect(sText As String) As String
 ' returns lowercase two character code eg "fr"
   MicrosoftTranslatorDetect = StringFromXML(MSHttpRequest("Detect?text=" & sText))
End Function

Function MSHttpRequest(sRequest As String) As String
Dim sURL As String, oH As Object, sToken As String
   sURL = "http://api.microsofttranslator.com/V2/Http.svc/" & sRequest
   sToken = GetAccessToken()
   Set oH = CreateObject("MSXML2.XMLHTTP")
   oH.Open "GET", sURL, False
   oH.setRequestHeader "Authorization", "Bearer " & sToken
   oH.send
   MSHttpRequest = oH.responseText
   Set oH = Nothing
End Function

Function GetAccessToken() As String
Static sAccess_Token As String, dtExpiry_Time As Date
Const OAUTH_URI As String = "https://datamarket.accesscontrol.windows.net/v2/OAuth2-13"

'get Your Client ID and client secret from
'https://datamarket.azure.com/developer/applications
Const CLIENT_ID As String = "xxxxxxxxx"
Const CLIENT_SECRET As String = "1234567890abcdefghijklmnopqrstuvwxyz"
Dim sRequest As String, sResponse As String
Dim webRequest As Object

If Now() > dtExpiry_Time Then ' time for a new access token
   Set webRequest = CreateObject("MSXML2.XMLHTTP")

   sRequest = "grant_type=client_credentials" & _
         "&client_id=" & CLIENT_ID & _
         "&client_secret=" & URLEncode(CLIENT_SECRET) & _
         "&scope=http://api.microsofttranslator.com"
   webRequest.Open "POST", OAUTH_URI, False
   webRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   webRequest.send (sRequest)
   sResponse = webRequest.responseText
   Set webRequest = Nothing

   If InStr(1, sResponse, """error:""", vbTextCompare) > 0 Then
      Err.Raise 9999, "GetAccessToken " & sResponse
   End If

   sAccess_Token = NameValue("access_token", sResponse)
   dtExpiry_Time = Now() + Val(NameValue("expires_in", sResponse)) / 60 / 60 / 24 ' maybe *.95 for safety margin
   'Debug.Print "Token expires at "; Format$(dtExpiry_Time, "hh:mm:ss")
End If
GetAccessToken = sAccess_Token
End Function

Now with the new Microsoft Azure, it would appear that my free ride is over. So now I need to convert my VBA code. I looked and have not yet found a good reference which would assist in converting the attached routines. I'm not bad in VBA but need help getting these new functions implemented.

Can someone help or point me to some references (for novices like me) which will get me going with the new system.

After I get something running I can decide whether it is worth my money for this little application.

Thanks.....RDK

Answer 1

Actually Translator API in Azure Coginitve Services starts with a free tier. https://www.microsoft.com/cognitive-services/en-us/pricing

The main difference of the new API is the way to get token. http://docs.microsofttranslator.com/oauth-token.html

The rest is the same I think. You can find the reference here: docs.microsofttranslator.com/text-translate.html

Answer 2

I use this Code in Access to translate single line text Translator code in VBA

Function TranslatorTextAPI(sText As String)
    'Single step translation code
    'for Key info if authentication is failing goto https://portal.azure.com/ log in and refresh keys and update Key information below
    'if you cannot find keys you can create new azure account goto link below it is a free service for less then 2 million words
    'https://learn.microsoft.com/en-us/azure/cognitive-services/translator/translator-text-how-to-signup
    If Len(sText) > 0 Then 'if blank do nothing return the blank value
        Dim sHost As String
        Dim zTTxt As String
        Dim zKey As String
        Dim startpl, endpl As Integer

        zKey = "subscriptionKey" 'authentication Key from subscription
        sHost = "https://api.cognitive.microsofttranslator.com/translate?api-version=3.0" 'required link for authentication
        sHost = sHost & "&from=fr&to=en" 'determine language from and langauge to
        zTTxt = "[{""text"":" & """" & sText & """}]" 'JSON format spcific requirement [{"text":"value"}] max 5000 characters

        Dim Tlang As Object
        Set Tlang = CreateObject("WinHttp.WinHttpRequest.5.1") 'need to add reference libary "Microsft WinHTTP Service,Version 5.1"
        Tlang.Open "POST", sHost, False 'open connection to "Translator Text API" POST command required
        Tlang.SetRequestHeader "Ocp-Apim-Subscription-Key", zKey 'authentication Required
        Tlang.SetRequestHeader "Content-type", "Application/json" 'Content-type Required
        Tlang.Send zTTxt 'format = [{"text":"Bonjour utilisateur"}]
        Tlang.WaitForResponse 'the response takes 1+ seconds needs wait or delay command or results will fail as response has not returned data yet
        'Debug.Print Tlang.GetAllResponseHeaders

        startpl = 28 'if you use auto languae detect you will need to adjust this number to "69" or greater
        endpl = InStr(startpl, Tlang.ResponseText, """") '[{"translations":[{"text":"Hello user","to":"en"}]}]
        TranslatorTextAPI = Mid(Tlang.ResponseText, startpl, endpl - startpl) 'Parse out translated text
        Tlang.Abort
    Else
        TranslatorTextAPI = sText 'if blank do nothing return the blank value
    End If
End Function