Office関連

モヤさまのショウ君にいろいろ喋らせるVBAマクロ(1)

「VoiceText Web API」(β版) の提供を開始」にあるように、2014年7月9日から音声合成ソフトウェア「VoiceText」のWeb APIが公開されました。

・VoiceText Web API (β版)
https://cloud.voicetext.jp/webapi

VoiceTextと言えばモヤさまこと、モヤモヤさまぁ~ず2のショウ君で有名なあのソフトです。

これはもう使ってみるしかない!
VBAから!!

・・・というわけで早速使ってみました。

■ APIキーの取得

まずはAPIの利用に必要なキーの取得です。
利用登録ページで必要な情報を入力して登録申請すると、

VoiceTextWebAPI_01_01

すぐに登録したEメールアドレス宛にキーが届きます。

VoiceTextWebAPI_01_02

■ APIの使い方

APIの使い方は「API マニュアル」に記載されています。

APIキーをユーザー名、パスワードを空としてBasic認証を行い、https://api.voicetext.jp/v1/ttsにパラメーターを付けてリクエストを送るだけです。
問題なくリクエストが通ると、wav形式の音声ファイルが返ってきます。

※ パラメーター等の詳しい説明は上記マニュアルページをご参照ください。

■ VBAマクロからAPIを使用する

VBAからWeb APIを呼び出す方法は色々ありますが、今回のような場合はWinHttpRequestXMLHTTPRequestを使うのが簡単です。

問題になるのはBasic認証部分ですが、これもSetRequestHeaderAuthorizationヘッダーを付ければ問題ありません。

その際ユーザー名とパスワードをBase64エンコードする必要がありますが(Basic認証 参照)、「Gmail APIを使ってメール送信するVBAマクロ(3)」でも使っている関数(EncodeBase64Str)があるので、これをそのまま流用します。

というわけで、書いたサンプルコードが下記になります。

Option Explicit

Public Sub Sample()
  Dim url As String
  Dim txt As String
  Dim pathWavFile As String
  Dim dat As Variant
  Dim body() As Byte
  
  Const adTypeBinary = 1
  Const API_KEY As String = "(APIキー)" 'コードを動かす際はここに受け取ったAPIキーを記載します。
  
  pathWavFile = "C:\Test\TTS.wav"
  url = "https://api.voicetext.jp/v1/tts"
  txt = "こんばんは。今日も一日暑かったよね。最高気温は36度でした。"
  dat = "text=" & EncodeURL(txt) & "&speaker=show"
  
  'ファイル削除
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(pathWavFile) Then
      .DeleteFile pathWavFile, True
    End If
  End With
  
  'wavファイルをダウンロードして再生
  On Error GoTo Err:
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "POST", url, False
    .SetRequestHeader "Authorization", "Basic " & EncodeBase64Str(API_KEY & ":")
    .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8"
    .Send dat
    Select Case .Status
      Case 200
        body = .responseBody
        With CreateObject("ADODB.Stream")
          .Type = adTypeBinary
          .Open
          .Write body
          .SaveToFile pathWavFile
          .Close
        End With
        CreateObject("Shell.Application").ShellExecute pathWavFile
      Case Else
        MsgBox "処理が失敗しました。" & vbCrLf & vbCrLf & .ResponseText, vbExclamation + vbSystemModal
        Exit Sub
    End Select
  End With
  On Error GoTo 0
  Exit Sub
  
Err:
  Debug.Print "エラーが発生しました。", Err.Number, Err.Description
End Sub

Private Function EncodeURL(ByVal str As String) As String
'URLエンコード
  With CreateObject("ScriptControl")
    .Language = "JScript"
    EncodeURL = .CodeObject.encodeURIComponent(str)
  End With
End Function

Private Function EncodeBase64Str(ByVal str As String) As String
'文字列をBase64エンコード
  Dim ret As String
  Dim d() As Byte
  
  Const adTypeBinary = 1
  Const adTypeText = 2
  
  ret = "" '初期化
  On Error Resume Next
  With CreateObject("ADODB.Stream")
    .Open
    .Type = adTypeText
    .Charset = "UTF-8"
    .WriteText str
    .Position = 0
    .Type = adTypeBinary
    .Position = 3
    d = .Read()
    .Close
  End With
  With CreateObject("MSXML2.DOMDocument").createElement("base64")
    .DataType = "bin.base64"
    .nodeTypedValue = d
    ret = .Text
  End With
  On Error GoTo 0
  EncodeBase64Str = ret
End Function

ScriptControlを使っているので64ビット版のOfficeでは動きませんが、32ビット版のOfficeでは無事に動作しました。

これで気分はモヤさまです。
いつでもあのゆる~いVoiceを聴くことができます。
素晴らしいAPIです。

ただし、このAPIの利用には、読み上げる文字は200文字以内

第6条 (テキスト及び音声データの取り扱い)
ユーザは、本サービスの利用に際し、入力されたテキストおよび出力される音声データの取り扱いについて、次の各号の条件を承諾するものとします。また、本サービスを利用したアプリケーションのエンドユーザに対しても自己の責任により、本規約の内容を承諾させるものとします。
(1)当社が、当社のサーバーに入力されたテキストを、本サービスおよび音声合成技術の改良の目的で利用すること
(2)当社のサーバーから出力された音声データは、本サービスを利用したアプリケーション内のみで使用すること
(3)当社のサーバーから出力された音声データを、直接的または間接的に配布しないこと(但し、当社の事前の書面による承諾がある場合はこの限りではありません)

「VoiceText Web API」サービス利用規約 より

といった制限もありますので、その点はご注意ください。
特に利用規約には必ず目を通すようにしましょう。

今回の記事はここまで。
次回ももうちょっとこのAPIで遊んでみることにします。

→ 続きの記事を書いてみました。

・モヤさまのショウ君にいろいろ喋らせるVBAマクロ(2)
//www.ka-net.org/blog/?p=4718

関連記事

  1. Office関連

    [Wordマクロ]PrintOutメソッド実行時に「型が一致しません」との実行時エラーが発生する。

    Wordマクロで文書を印刷するときはPrintOutメソッドをよく使い…

  2. Office関連

    PDFを他のファイル形式に変換するVBAマクロ

    「PDF 変換 Word VBA」といったキーワード検索でのアクセスが…

  3. Office アドイン

    [Office用アプリ]メールアプリの配置方法

    OutlookやOutlook Web App上で動作するメールアプリ…

  4. Office関連

    OneNote + Google Apps Scriptで定期的にWebサイトのキャプチャーを撮る方…

    「“OneNote”がアップデート、URLをメールで送るだけでスクリー…

  5. Office関連

    PowerPointスライドショー終了後ファイルを閉じるVBAマクロ

    「Excel VBA PowerPoint スライドショー後閉じる」と…

コメント

  1. この記事へのコメントはありません。

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP