【第3回】VBAでのJSON操作：基礎から応用まで（REST APIでの実践例）

REST API
2024.12.21

REST APIを使ったデータのやり取りでは、JSON形式が一般的に利用されます。JSONは軽量で柔軟なデータ形式ですが、その操作方法を理解することは、REST APIを活用する上で不可欠です。この記事では、JSONデータの操作方法を基礎から応用まで解説します。

さらに、実際のVBAコードを例に、REST APIのリクエストやレスポンスデータをどのように操作するかを具体的に示します。

JSONの基本操作

JSONとは？

JSON（JavaScript Object Notation）は、データをオブジェクトや配列の形式で表現する軽量なデータフォーマットです。キーと値のペアで情報を保持し、階層的なデータ構造を簡単に表現できます。

例：JSONデータの基本構造

{
    "speedScale": 1.0,
    "pitchScale": 0.0,
    "intonationScale": 1.0,
    "volumeScale": 1.0
}
このデータでは、各キー（speedScale など）に対して値が割り当てられています。

詳細はこちらで紹介しています。

【第2回】JSONとは？初心者向けフォーマット解説
JSONの基本JSON（JavaScript Object Notation）は、軽量で簡単に読み書きできるデータフォーマットです。REST APIのデータ交換や設定ファイルの保存形式として広く使われています。JSONの特徴キーバリュー型J...
zaiteku-banzai.com
2024.12.21

必要な準備

JSON操作用のライブラリ

VBAでJSONを操作するには、サードパーティのJSON解析ライブラリを使用します。ここでは「VBA-JSON」を利用します。

JSONConverter.bas のインストール方法

  1. VBA-JSONのリポジトリから JsonConverter.bas をダウンロードします。
  2. ExcelのVBAエディタを開き（Alt + F11）、プロジェクトに右クリックして「インポート」を選択します。
  3. ダウンロードした JsonConverter.bas ファイルを選択してインポートします。

ライセンス情報については、記事末尾に記載しています。

JSON操作の実践

以下の操作例では、REST APIから取得したJSONデータを基にパラメーター操作を行います。

値の取得

以下のコードは、レスポンスデータから speedScale の値を取得する例です。

Dim audioQuery As Object
Set audioQuery = JsonConverter.ParseJson(responseText)
Debug.Print "speedScale: " & audioQuery("speedScale")

responseTextはREST APIから戻って来たレスポンスです。

JsonConverter.ParseJson()を利用してJSONをパースしたオブジェクトを受け取ります。これで受け取ったオブジェクト（audioQuery）で、JSONを便利に操作する事が可能となります。

パースしたオブジェクトに取得したいキー名を与える事で、値を取得する事が可能になります。

値の変更

次に、speedScale の値を変更する例です。

audioQuery("speedScale") = 1.5 ' 話速を1.5倍に変更

キー名を指定して値を代入します。

パラメーターの追加

新しいパラメーターを追加する方法です。

audioQuery("newParameter") = "新しい値"

パラメーターの削除

以下の方法でキーと値を削除します。

Dim keyToRemove As String
keyToRemove = "volumeScale"
If Not audioQuery(keyToRemove) Is Nothing Then
    Call audioQuery.Remove(keyToRemove)
End If

JSON文字列に戻す

操作したJSONデータを文字列形式に変換して、REST APIリクエストに使用します。

Dim jsonString As String
jsonString = JsonConverter.ConvertToJson(audioQuery)
Debug.Print "Updated JSON: " & jsonString
 

実践例：話速を変更してREST APIを利用

以下のコードでは、話速を変更しながら音声を生成し、WAVファイルとして保存します。ワークシートのC列に話速を指定し、D列に出力されたファイル名を記録します。

Option Explicit

' 定数定義
Const SPEAKER_ID_ZUNDAMON As Integer = 1 ' ずんだもんのスピーカーID
Const OUTPUT_DIR As String = "\output\" ' 出力ディレクトリ
Const API_BASE_URL As String = "http://localhost:50021/" ' REST APIベースURL

'-------------------------------------------------------------------
' 関数名: VoiceVoxBatchExecute
' 機能: ワークシートに入力されたテキストを順に音声合成し、話速を指定してファイルを生成する
' 引数: なし
' 戻り値: なし
'-------------------------------------------------------------------
Sub VoiceVoxBatchExecute()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim text As String
    Dim speedScale As Double
    Dim outputDir As String
    
    ' 使用するシート（必要に応じて変更）
    Set ws = ThisWorkbook.Sheets(1)
    
    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).row
    
    ' 出力ディレクトリ設定
    outputDir = ThisWorkbook.Path & OUTPUT_DIR
    If Dir(outputDir, vbDirectory) = "" Then MkDir outputDir

    On Error GoTo ErrorHandler ' エラーハンドリング開始

    ' 2行目から処理開始
    For i = 2 To lastRow
        Application.StatusBar = "Processing row " & i & " of " & lastRow
        
        ' テキストと話速の取得
        text = Trim(ws.Cells(i, "B").Value)
        text = CleanText(text)
        speedScale = ws.Cells(i, "C").Value
        
        ' テキストが空の場合は終了
        If Len(text) = 0 Then Exit For
        
        ' 音声クエリ生成・合成・出力の実行
        Call ProcessVoiceVoxText(ws, i, text, speedScale, SPEAKER_ID_ZUNDAMON, outputDir)
    Next i
    
    Application.StatusBar = False
    MsgBox "すべての処理が完了しました！"
    Exit Sub ' 正常終了

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical, "エラー"
    Application.StatusBar = False
End Sub

'-------------------------------------------------------------------
' 関数名: ProcessVoiceVoxText
' 機能: 音声クエリの生成、合成、ファイル出力をまとめて処理する
' 引数:
'   in ws (Worksheet): 対象のワークシート
'   in row (Long): 処理中の行番号
'   in text (String): 音声合成するテキスト
'   in speedScale (Double): 話速
'   in speaker (Integer): 話者のID
'   in outputDir (String): 出力ディレクトリのパス
' 戻り値: なし
'-------------------------------------------------------------------
Sub ProcessVoiceVoxText(ws As Worksheet, row As Long, text As String, speedScale As Double, speaker As Integer, outputDir As String)
    Dim http As Object
    Dim audioQuery As String
    Dim outputFileName As String
    
    ' HTTPオブジェクト作成
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    ' 音声クエリ生成
    audioQuery = GenerateAudioQuery(http, speaker, text, speedScale)
    
    ' 音声ファイル名を生成
    outputFileName = ws.Cells(row, "A").Value & "_" & Format(Now, "yyyymmdd_HHMMSS") & ".wav"
    
    ' 音声合成とファイル出力
    SynthesizeAndSaveWAV http, audioQuery, speaker, outputDir & outputFileName
    
    ' 成功時にセルにファイル名を記載し、リンクを追加
    ws.Hyperlinks.Add ws.Cells(row, "D"), outputDir & outputFileName, , , outputFileName
End Sub

'-------------------------------------------------------------------
' 関数名: GenerateAudioQuery
' 機能: REST APIを使って音声クエリを生成する
' 引数:
'   in http (Object): HTTPリクエスト用のオブジェクト
'   in speaker (Integer): 話者のID
'   in text (String): 音声合成するテキスト
'   in speedScale (Double): 話速
' 戻り値:
'   out (String): 音声クエリのJSON文字列
'-------------------------------------------------------------------
Function GenerateAudioQuery(http As Object, speaker As Integer, text As String, speedScale As Double) As String
    Dim queryURL As String
    Dim responseText As String
    Dim audioQuery As Object
    
    queryURL = API_BASE_URL & "audio_query?text=" & WorksheetFunction.EncodeURL(text) & "&speaker=" & speaker
    
    On Error Resume Next
    http.Open "POST", queryURL, False
    http.setRequestHeader "accept", "application/json"
    http.Send
    On Error GoTo 0

    If http.Status = 200 Then
        Set audioQuery = JsonConverter.ParseJson(http.responseText)
        audioQuery("speedScale") = speedScale
        GenerateAudioQuery = JsonConverter.ConvertToJson(audioQuery)
    Else
        Err.Raise vbObjectError + 1, "GenerateAudioQuery", _
                  "[Error] 音声クエリ生成に失敗しました。Status: " & http.Status & _
                  ", Response: " & http.responseText
    End If
End Function

'-------------------------------------------------------------------
' 関数名: SynthesizeAndSaveWAV
' 機能: REST APIを使って音声を合成し、WAVファイルとして保存する
' 引数:
'   in http (Object): HTTPリクエスト用のオブジェクト
'   in audioQuery (String): 音声クエリのJSON文字列
'   in speaker (Integer): 話者のID
'   in outputFilePath (String): 出力ファイルのパス
' 戻り値: なし
'-------------------------------------------------------------------
Sub SynthesizeAndSaveWAV(http As Object, audioQuery As String, speaker As Integer, outputFilePath As String)
    Dim synthesisURL As String
    Dim responseBody As Variant
    synthesisURL = API_BASE_URL & "synthesis?speaker=" & speaker & "&enable_interrogative_upspeak=true"
    
    http.Open "POST", synthesisURL, False
    http.setRequestHeader "accept", "audio/wav"
    http.setRequestHeader "Content-Type", "application/json"
    http.Send audioQuery

    If http.Status = 200 Then
        responseBody = http.responseBody
        SaveBinaryDataWithWAVHeader responseBody, outputFilePath
    Else
        Err.Raise vbObjectError + 2, "SynthesizeAndSaveWAV", _
                  "[Error] 音声合成に失敗しました。Status: " & http.Status & _
                  ", Response: " & http.responseText
    End If
End Sub

'-------------------------------------------------------------------
' 関数名: SaveBinaryDataWithWAVHeader
' 機能: 音声データに正しいWAVフォーマットのヘッダーを追加し、ファイルに保存する
' 引数:
'   in responseBody (Variant): 音声データのバイナリ
'   in outputFilePath (String): 出力ファイルのパス
' 戻り値: なし
'-------------------------------------------------------------------
Sub SaveBinaryDataWithWAVHeader(responseBody As Variant, outputFilePath As String)
    Dim fileNum As Integer
    Dim wavHeader As String
    Dim dataSize As Long

    ' WAVフォーマットの正しいヘッダーを作成
    wavHeader = "52494646" & _
                "50814501" & _
                "57415645" & _
                "666d7420" & _
                "10000000" & _
                "01000100" & _
                "c05d0000" & _
                "80bb0000" & _
                "02001000" & _
                "64617461"

    ' データサイズを計算
    dataSize = LenB(responseBody)
    wavHeader = wavHeader & Right("00000000" & Hex(dataSize), 8)

    ' ファイルにヘッダーとデータを書き込む
    fileNum = FreeFile
    Open outputFilePath For Binary Access Write As #fileNum
    Put #fileNum, , HexToBinary(wavHeader)
    Put #fileNum, , responseBody
    Close #fileNum
End Sub

'-------------------------------------------------------------------
' 関数名: HexToBinary
' 機能: 16進文字列をバイナリデータに変換する
' 引数:
'   in hexString (String): 16進数形式の文字列
' 戻り値:
'   out (Byte()): バイナリデータ配列
'-------------------------------------------------------------------
Function HexToBinary(hexString As String) As Byte()
    Dim binaryData() As Byte
    Dim i As Long
    ReDim binaryData(Len(hexString) \ 2 - 1)
    For i = 0 To UBound(binaryData)
        binaryData(i) = CByte("&H" & Mid(hexString, i * 2 + 1, 2))
    Next i
    HexToBinary = binaryData
End Function

'-------------------------------------------------------------------
' 関数名: CleanText
' 機能: テキストから改行やエスケープ文字を削除する
' 引数:
'   in text (String): 入力テキスト
' 戻り値:
'   out (String): クリーンアップされたテキスト
'-------------------------------------------------------------------
Function CleanText(text As String) As String
    Dim tempText As String
    tempText = Replace(text, vbCr, "")
    tempText = Replace(tempText, vbLf, "")
    tempText = Replace(tempText, "\", "")
    CleanText = tempText
End Function
 

ライセンス情報

このコードでは「VBA-JSON」を使用しています。以下にライセンス情報を記載します。

MIT License
Copyright (c) Tim Hall
Permission is hereby granted, free of charge, to any person obtaining a copy of this software...
 

次回予告

次回は、REST APIのエラー処理をさらに高度化し、より複雑なJSON操作やエラー対応を解説します。効率的で堅牢なコードを書くためのポイントを学びましょう！

コメント

タイトルとURLをコピーしました