以前書いた記事で、Google翻訳を使って文字列を翻訳するマクロを紹介したのですが、仕様変更があったようで、もうこのマクロは使用できなくなっています。

有償のTranslate APIに切り替えれば、似たようなコードで処理できるだろうと思いますが、ここはGoogleにこだわらず、無償である程度使える「Microsoft Translator API」を使って文字列を翻訳するVBAマクロを作ってみたいと思います。

Azure Marketplaceでのアプリケーション登録

マクロからAPIを呼び出すにあたり、まずはMicrosoft Azure Marketplaceでアプリケーション登録を行う必要があります。

1. Microsoft Azure Marketplace右上にある「サインイン」から「個人」を選択し、Microsoft アカウントでサインインします。Microsoft アカウントを持っていない場合は、「Microsoft アカウントの新規作成」からアカウントを新規登録しておきます。



2. Azure Marketplaceの登録画面が表示されたら、氏名等の必要事項を入力し、「続行」ボタンをクリックします。



3. 使用条件画面が表示されたら、内容を確認した上で「使用条件に同意します」にチェックを入れ、「登録」ボタンをクリックします。



4. Azure Marketplaceへの登録が終わったら「Microsoft Translator」から、月額 ¥0の下にある「サインアップ」ボタンをクリックします(Microsoft Translatorは月間200万文字まで無償で利用できます)。



5. サインアップ画面が表示されたら、公開元のオファーとプライバシー ポリシーを確認した後、「前述の公開元のオファー条件とプライバシー ポリシーを読み、内容に同意しました。」にチェックを入れ、「サインアップ」ボタンをクリックします。



6. 「ありがとうございます」画面が表示されたらサインアップ完了です。



7. Microsoft Translatorのサインアップが終わったら、Microsoft Azure Marketplaceの右下から「アプリケーションの登録」を開きます。



8. アプリケーションの登録画面が表示されたら、各項目を入力し「作成」ボタンをクリックします。
• クライアント ID：後述のAPI呼び出しに必要なものです。入力後はメモ帳などにコピーしておきます。
• 名前：アプリケーション名です。
• 顧客の秘密(クライアント シークレット)：後述のAPI呼び出しに必要なものです。通常はデフォルトで表示されている文字列で良いでしょう。クライアント IDと同じく、メモ帳などにコピーしておきます。
• リダイレクト URI：今回はVBAからの呼び出しを行う予定なので、「https://localhost/」などの適当なURIで問題ありません。
• サブドメイン アクセスを有効にする：今回はチェックする必要はありません。
• 説明：今回は特に入力する必要はありません。

以上で準備作業は終了です。

VBAからのMicrosoft Translator API呼び出し

クライアント IDとクライアント シークレットの準備ができたら、いよいよマクロからAPIを呼び出していきます。

APIを利用する手順はザックリ書くと下記の通りです。

https://datamarket.accesscontrol.windows.net/v2/OAuth2-13 に必要なパラメータを付けてPOSTします(Obtaining an Access Token参照)。
↓
JSON形式で返ってきたレスポンスからアクセス トークンを取得します。
↓
各APIのリクエストURIに、Authorizationヘッダーにアクセス トークンを付けて、リクエストを投げます。
↓
帰ってきたレスポンスから必要なデータを取得・利用します。

詳細については、Microsoft Translatorや各メソッドの説明をご参照ください。

そして実際に書いたコードが下記になります。

※ クライアント IDとクライアント シークレットは上記手順で取得したものを入力してください。
※ 下記コードはScriptControlを使用しているため、64ビット版のOfficeでは使用できません。

Option Explicit

Public Sub Sample()
  Dim client_id As String
  Dim client_secret As String
  Dim source_str As String
  
  '********** 要変更 **********
  client_id = "(クライアント ID)"
  client_secret = "(クライアント シークレット)"
  source_str = "こんばんは。月が綺麗ですね。"
  '****************************
  
  With CreateObject("WScript.Shell")
    '日本語→英語
    .Popup TranslateStringMS(client_id, _
                             client_secret, _
                             source_str)
    '日本語→中国語(繁体字)
    .Popup TranslateStringMS(client_id, _
                             client_secret, _
                             source_str, _
                             "ja", _
                             "zh-CHT")
  End With
End Sub

Public Function TranslateStringMS(ByVal client_id As String, _
                                  ByVal client_secret As String, _
                                  ByVal source_str As String, _
                                  Optional ByVal from_lang As String = "ja", _
                                  Optional ByVal to_lang As String = "en")
'Microsoft Translator APIを使って文字列を翻訳
'利用可能な言語コードは https://msdn.microsoft.com/en-us/library/hh456380.aspx 参照
'※ ScriptControlを使用しているため、64ビット版Officeでは使用不可
  Dim url As String
  Dim access_token As String
  Dim ret As String
  Dim d As Object
  
  ret = "": Set d = Nothing '初期化
  access_token = GetAccessToken(client_id, client_secret)
  url = "http://api.microsofttranslator.com/v2/Http.svc/Translate" & _
        "?text=" & EncodeURL(source_str) & _
        "&from=" & from_lang & _
        "&to=" & to_lang
  On Error Resume Next
  If Len(Trim(access_token)) > 0 Then
    With CreateObject("MSXML2.XMLHTTP")
      .Open "GET", url, False
      .setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=utf-8"
      .setRequestHeader "Authorization", "Bearer " & access_token
      .Send
      Select Case .Status
        Case 200: Set d = .responseXML
      End Select
    End With
    If Not d Is Nothing Then ret = d.Text
  End If
  On Error GoTo 0
  TranslateStringMS = ret
End Function

Private Function GetAccessToken(ByVal client_id As String, _
                                ByVal client_secret As String, _
                                Optional ByVal grant_type As String = "client_credentials", _
                                Optional ByVal scope As String = "http://api.microsofttranslator.com") As String
'アクセストークンを取得
  Dim url As String
  Dim js As String
  Dim ret As String
  Dim dat As Variant
  Dim access_token '表示用ダミー
  
  js = "": ret = "" '初期化
  client_id = EncodeURL(client_id)
  client_secret = EncodeURL(client_secret)
  url = "https://datamarket.accesscontrol.windows.net/v2/OAuth2-13"
  dat = "grant_type=" & grant_type & "&client_id=" & client_id & _
        "&client_secret=" & client_secret & "&scope=" & scope
  On Error Resume Next
  With CreateObject("MSXML2.XMLHTTP")
    .Open "POST", url, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=utf-8"
    .Send dat
    Select Case .Status
      Case 200: js = .responseText
    End Select
  End With
  If Len(Trim(js)) > 0 Then
    js = "(" & js & ")"
    With CreateObject("ScriptControl")
      .Language = "JScript"
      ret = .CodeObject.eval(js).access_token
    End With
  End If
  On Error GoTo 0
  GetAccessToken = ret
End Function

Private Function EncodeURL(ByVal str As String) As String
  With CreateObject("ScriptControl")
    .Language = "JScript"
    EncodeURL = .CodeObject.encodeURIComponent(str)
  End With
End Function

上記「Sample」を実行すると、問題が無ければ下図のようにメッセージボックスが表示されます。

「TranslateStringMS」では、引数「from_lang」と「to_lang」で翻訳元の言語と翻訳先の言語を指定します。
ここで利用可能な言語コードについては、「Translator Language Codes」をご参照ください。

というわけで、今回はVBAからMicrosoft Translator APIを呼び出してみました。
本当は毎回毎回アクセス トークンを取得する必要は無いのですが、有効期限が切れたらトークンを取得しなおして・・・なんて処理は、面倒くさいので今回は省いています。