Использование Azure Translator в макросе Excal VBA

Question

Уже более 5 лет я использую этот код для преобразования введенного пользователем английского текста в французский или немецкий в макросе Excel VBA. Это было с Microsoft Azure Marketplace, и, поскольку мое использование было минимальным, оно было бесплатным.

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

Теперь, когда появился новый Microsoft Azure, моя бесплатная поездка закончилась. Так что теперь мне нужно конвертировать мой код VBA. Я посмотрел и еще не нашел хорошего справочника, который помог бы конвертировать прикрепленные подпрограммы. Я не плох в VBA, но мне нужна помощь для реализации этих новых функций.

Может кто-нибудь помочь или указать мне некоторые ссылки (для новичков, как я), которые помогут мне перейти на новую систему.

После того, как я что-то запустил, я могу решить, стоит ли это моих денег для этого небольшого приложения.

Спасибо..... РДК

Answer 1

На самом деле API переводчика в Azure Coginitve Services начинается с бесплатного уровня. https://www.microsoft.com/cognitive-services/en-us/pricing

Основным отличием нового API является способ получения токена. http://docs.microsofttranslator.com/oauth-token.html

В остальном я думаю то же самое. Вы можете найти ссылку здесь: docs.microsofttranslator.com/text-translate.html

Answer 2

Я использую этот код в Access для перевода однострочного текста. Код переводчика в 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://docs.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