excel - 在 Excel VBA 宏中使用 Azure 翻译器

Question

五年多来，我一直在使用此代码在 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 还不错，但需要帮助来实现这些新功能。

有人可以帮助我或向我指出一些引用资料(对于像我这样的新手)，这将使我能够使用新系统。

当我运行一些东西后，我可以决定这个小应用程序是否值得我花钱。

谢谢......RDK

Answer 1

我在 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://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