【Azure／Computer Vision】VBAだってクラウドできる！

はじめに

この記事では、Azure の Computer Vision のOCR機能をVBAから利用する方法について書きます。

なお、Azureに限らずクラウドサービスは思わぬ課金が発生することがありますので、ご利用は自己責任でお願いいたします。

Computer Vision とは

Computer Vision とは、AzureのAI サービスの一つで、その中に画像ファイルやPDFファイルから文字列を読み取るOCR機能が含まれています。
利用にはAzureアカウントの作成が必要になります。以下、Azureアカウントは作成済みという前提で話を進めます。

Computer Visionリソースの作成

まずはAzureポータルへ行き、visionで検索します。すると Computer Vision が現れるのでクリックします。

画面下部の Computer Visionの作成 をクリック。

リソースグループは既存のものがあればそれでもよし。ここでは新規作成します。

新規作成 をクリックしてリソースグループの名前を決めて入力。ここでは、Japan Eastリージョンの意味でjp-eを頭につけてjp-e-webappとしました。OKをクリック。

リージョンを選び、自分で決めたリソースの名前を入力します。価格レベルは、ここではFree F0を選択します。英語で書いてありますが、1 分あたり 20 件のトランザクションかつ月当たり5,000 無料トランザクション使えます。1トランザクションはPDFファイル 1ページが目安のようです。
「このボックスをオン...」にチェックを入れて確認と作成をクリック。

作成をクリック。

リソースに移動をクリック。

キー1とエンドポイントを控えておきます。

大まかな流れ

上で得たエンドポイントに画像をPOSTします。画像はクラウド上のものであればURLをJSONで送ります。ローカルからであればファイルをバイナリに変換して送ります。

リクエストが成功すると読み取り結果ではなく、読み取り結果が格納されたOperation Id（URLのこと）を返してきます。このURLにGETすることで読み取り結果が収められたJSONを得られます。
以下のリンクは、Computer Visionの中でもテキストを多用する画像や複数ページ・複数言語混在のPDF文書などから文字列を読み取ることに最適化されている Readオペレーション のリファレンスです。

Computer Vision API - POST Read のリファレンス

Computer Vision API - GET Read Result のリファレンス

リクエストは WinHttp.WinHttpRequest でやれ！

VBAでWeb APIへリクエストする場合、MSXML2.XMLHTTPオブジェクトを使うのが一般的です。ですが、今回のComputer Vision APIへのリクエストのテストにおいて、JSONのポストでは問題ありませんでしたが、バイナリのポストで以下のエラーとなりリクエストが失敗します。

「パラメーターが間違っています。」 いやいや間違ってはいないだろう 何か不足しているのか、あるいはバイナリの作り方に問題があるのか、目を凝らしてコードを眺めたり色々と試行錯誤しましたが、結局のところMSXML2.XMLHTTPを諦めてWinHttp.WinHttpRequestを使うことで解決に至りました。
以下、VBAでのComputer Vision API利用の一例です。

Module1.bas

Public Sub AnalyzeLocalImage()
    On Error GoTo Catch
    ' MSXML2.XMLHTTPはボツ
'    Dim httpReq As Object: Set httpReq = CreateObject("MSXML2.XMLHTTP")
    Dim httpReq As Object: Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    ' Azure Computer Vision APIのエンドポイントとキー
    Dim endpoint As String: endpoint = "https://{エンドポイントの名前}.cognitiveservices.azure.com/vision/v3.2/read/analyze"
    Dim subscKey As String: subscKey = "{キー}"

    ' ローカルの画像ファイルパス
    Dim imagePath As String: imagePath = "C:\{ファイルパス}\{ファイル名}.pdf"

    ' 画像ファイルをバイナリデータとして読み込む
    Dim imageBytes() As Byte: imageBytes = GetBinaryDataFromImage(imagePath)
    
    ' リクエストの実行
    httpReq.Open "POST", endpoint, False
    httpReq.SetRequestHeader "Content-Type", "application/octet-stream"
    httpReq.SetRequestHeader "Ocp-Apim-Subscription-Key", subscKey
    httpReq.Send imageBytes

    ' レスポンスの確認
    If httpReq.Status = 202 Then
        ' 成功した場合の処理
        Dim requestUrl As String: requestUrl = httpReq.GetResponseHeader("Operation-Location")
        Do
            ' 少し待機（例えば2秒）
            Call Application.Wait(Now + TimeValue("0:00:02"))
            
            ' 同じURLに繰り返しGETリクエストを行う（status が running の間）
            httpReq.Open "GET", requestUrl, False
            httpReq.SetRequestHeader "Ocp-Apim-Subscription-Key", subscKey
            httpReq.Send
            If httpReq.Status <> 200 Then
                Debug.Print "Error: " & httpReq.Status & " - " & httpReq.StatusText & " - " & httpReq.ResponseText
                GoTo Finally
            End If
            ' レスポンスを取得
            Dim jsonRes As String: jsonRes = httpReq.ResponseText
        
            ' レスポンスが running 以外ならループを抜ける
            If InStr(jsonRes, """status"":""running""") = 0 Then
                Exit Do
            End If
        Loop
        ' JSON Converterを使用してJSONをパース
        Dim json As Object
        Set json = JsonConverter.ParseJson(jsonRes)
        
        ' analyzeResultフィールドを取得
        Dim readResults As Object
        If json.Exists("analyzeResult") Then
            
            Set readResults = json("analyzeResult")("readResults")
            Dim fPage As Object, fLine As Object
            ' すべてのページをループ
            For Each fPage In readResults
                ' JSONデータ内のテキストデータをループ
                For Each fLine In fPage("lines")
                    Debug.Print fLine("text")
                Next
            Next
        Else
            ' analyzeResultフィールドが存在しない場合の処理
            Debug.Print "analyzeResult not found"
        End If
    Else
        ' エラーの場合の処理
        Debug.Print "Error: " & httpReq.Status & " - " & httpReq.StatusText & " - " & httpReq.ResponseText
    End If
    GoTo Finally
Catch:
    MsgBox Err.Description, vbExclamation
Finally:
    Set httpReq = Nothing
End Sub

Private Function GetBinaryDataFromImage(imagePath As String) As Byte()

    Dim sm As Object: Set sm = CreateObject("ADODB.Stream")
    
    ' Stream オブジェクトの設定
    With sm
        .Open
        .Type = 1 ' adTypeBinary
        .Position = 0
        .LoadFromFile imagePath ' ファイルを読み込む
        GetBinaryDataFromImage = .Read ' バイナリデータとして読み出す
        .Close
    End With
    
    Set sm = Nothing

End Function

あくまでも一例なので、キーやエンドポイントが丸見え（）なのはご愛嬌です。実用する場合はこんな書き方は止めましょう
エンドポイントの書き方は以下を参考にしました。

レスポンスのJSONのパースには、毎度おなじみのJsonConverterを使用しています。
JsonConverterは、Microsoft Scripting Runtime への参照設定が必須となることに注意してください。

精度が高くて大満足

とにかく読み取り精度が高いことに感動しました。手書きも見事に読み取ります。
パラメータとして?language=jaのように読み取る言語を指定したり、PDFファイルなら?pages=1-2,5のようにページ指定も可能です。
読み取ったすべての文字列はboundingBoxというフィールドに四隅の座標を持っています。これを解析すれば、読み取り結果を適切にレイアウトする助けになります。
さて、ここからは利用者の腕次第ということになりますね

おわりに

クラウドに傾倒している世の中ですが、使い方次第でクラウド環境も活用することができるVBA。あらためてお手軽で本当に便利だと思いました