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

ホーム
Office関連, Excel, Word, PowerPoint, Cognitive Services
Computer Vision APIを使って画像から文字列を取得するVBAマクロ

Office関連

2017.09.7

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から引っ張ってきたものです。