Office関連

Computer Vision APIを使って画像から文字列を取得するVBAマクロ

前々回の記事で、Fiddlerを使ってMicrosoft Cognitive ServicesのComputer Vision APIを呼び出してみましたが、今回はVBAマクロからAPIを呼び出してみようと思います。

VBAコード

さっそくコードです。
必要なエンドポイントURLやAPIキーは、前々回の記事を参考にして事前に取得しておいてください。

※ 下記コードはScriptControlを利用しているため、64ビット版Officeでは動作しません。

Option Explicit
 
Public Sub Sample()
  Debug.Print GetOCRTextUsingCognitiveServices("C:\Test\OCR.png")
End Sub
 
Private Function GetOCRTextUsingCognitiveServices(ByVal TargetFilePath As String, _
                                                  Optional ByVal TargetLanguage As String = "unk") As String
'CognitiveServices(Computer Vision API)を使って画像から文字列を取得
  Dim ret As String
  Dim js As String
  Dim url As String
  Dim dat As Variant
  
  Const apikey = "(APIキー)"
  Const adTypeBinary = 1
  Const adReadAll = -1
  url = "(エンドポイントURL)"
  If Right(url, 1) <> "/" Then url = url & "/"
  
  ret = "" '初期化
  
  'ファイル判定
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(TargetFilePath) = False Then GoTo Fin
    Select Case LCase(.GetExtensionName(TargetFilePath))
      Case "jpg", "jpeg", "png", "gif", "bmp"
      Case Else: GoTo Fin
    End Select
  End With
  
  'ファイル読込
  On Error Resume Next
  With CreateObject("ADODB.Stream")
    .Open
    .Type = adTypeBinary
    .LoadFromFile TargetFilePath
    dat = .Read(adReadAll)
    .Close
  End With
  If Err.Number <> 0 Then GoTo Fin
  On Error GoTo 0
  
  'Computer Vision API呼出
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "POST", url & "v1.0/ocr?language=" & TargetLanguage, False
    .setRequestHeader "Ocp-Apim-Subscription-Key", apikey
    .setRequestHeader "Content-Type", "application/octet-stream"
    .send dat
    Select Case .Status
      Case 200: js = .responseText
      Case Else: GoTo Fin
    End Select
  End With
  If Len(Trim(js)) > 0 Then ret = GetTextFromJSON(js)
  
Fin:
  GetOCRTextUsingCognitiveServices = ret
End Function
 
Private Function GetTextFromJSON(ByVal js As String) As String
'JSONデータからテキスト取得
  Dim obj As Object
  Dim objRegions As Object
  Dim objRegion As Object
  Dim objLines As Object
  Dim objLine As Object
  Dim objWords As Object
  Dim objWord As Object
  Dim ret As String
  
  ret = "": js = "(" & js & ")" '初期化
  With CreateObject("ScriptControl")
    .Language = "JScript"
    Set obj = .Eval(js)
    Set objRegions = VBA.CallByName(obj, "regions", VbGet)
    For Each objRegion In objRegions
      If Not objRegion Is Nothing Then
        Set objLines = VBA.CallByName(objRegion, "lines", VbGet)
        For Each objLine In objLines
          Set objWords = VBA.CallByName(objLine, "words", VbGet)
          For Each objWord In objWords
            ret = ret & VBA.CallByName(objWord, "text", VbGet)
          Next
        Next
      End If
    Next
  End With
  GetTextFromJSON = ret
End Function

上記コードでは、GetOCRTextUsingCognitiveServicesプロシージャの第二引数で言語を指定できるようにしています。
標準の「unk」にしておけば自動判別されますが、意図した通りの言語で認識されない場合は、Cognitive Services APIs Referenceを参考に、言語を指定してください。

実行結果

上記マクロを実行した結果は、下記の通りでした。

日本における「夏(なっ)」の定義は、前述の中国暦の「A(xia)」の定義の強い影響を受けた上、近代においてクレコリオ暦に付随する欧米の文化的影響も受けて複雑な様相を呈している。中国暦以外の暦法を知らなかった前近代の時期には、中国暦の「A(xia)」の定義を日本人もそのまま受け人れさるを得なかった。しかし、海洋性気候てあり、肝心の夏至の時期には梅雨により日射が遮られる日本ては、前述の昼間の長さと気温のスレは中国より著しく大きくなる。日本列島においては、気温のヒ-クは立秋の時期にずれこむため、気温がヒ-クになる頃には、夏が糸冬わって秋が始まってしまっているという現象が生じることになる。このヰャップが、現在ても「暦の上では・・夏(秋)てすが・・・(気温の実感は全く違います)」というフレ-スが天気予報などて頻繁に用いられる原因となっている。

テストに使用したのが下記画像で、元の文はWikipediaから引っ張ってきたものです。

テキスト比較ツールで元の文と比較してみると、どこが認識できていないのかがよく分かります。

括弧や濁点の認識が上手くいっていませんが、ここまで認識できれば上出来です!
VBAから扱いづらいJSON形式のレスポンスが難点ですが、ScriptControlを使えば比較的簡単に処理できるでしょう。
アイデア次第で活用の場が広がると思うので、興味がある方は是非お試しください。

2017年8月の人気記事前のページ

スライドショーをループ再生設定するPowerPointマクロ次のページ

関連記事

  1. Office関連

    Office クリップボードをマクロで操作する(UI Automation)

    以前MSAAを利用してOffice クリップボードを操作するマクロを書…

  2. Office アドイン

    [Officeアドイン]ワークシートで選択範囲を変更したときに発生するイベント

    ワークシート上で選択範囲の変更を検知する際、VBAでは通常「Works…

  3. Office関連

    Excel REST APIをPowerShellから呼び出す方法

    以前Excel REST APIをVBAから呼び出す方法を紹介しました…

  4. Office アドイン

    [Officeアドイン]アドイン コマンド(Add-In Commands)の紹介

    前回の記事は“Office アドイン”のAdvent calendar…

  5. Office アドイン

    [Office用アプリ]「ActiveViewChanged」イベントと「getActiveView…

    v1.1で追加された、ビューが変更された時に発生するイベント「Acti…

  6. Office関連

    [Office 365 Solo]Skypeってスマートフォンからも使えるの?

    「Office 365 Soloをインストールしみてました。」でも書い…

コメント

  • コメント (0)

  • トラックバックは利用できません。

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP