VBAでPDFからデータ抽出

EXCEL

Office文書の自動化に日々奮闘されている皆さん、こんにちは。今回は、VBAでPDFファイルから必要なデータを抽出するという、多くのビジネスシーンで要望されるテーマに挑戦します。特に、「外部ライブラリを一切使わず、VBAとWin32 APIだけで完結させる」という、ある意味で究極の制約の中で、いかに実務レベルのソリューションを構築するか、その思考プロセスと具体的な実装方法を解説していきます。

背景と要件 – なぜVBAでPDF抽出に取り組むのか

ビジネスにおいてPDF形式の文書は、請求書、報告書、契約書など、あらゆる場面で利用されています。これらのPDFに含まれるデータを業務システムに取り込んだり、集計したりする必要があるケースは枚挙にいとまがありません。しかし、PDFは人間が視覚的に読むことに特化したフォーマットであり、プログラムから構造化されたデータを直接抽出することは容易ではありません。

通常、この課題を解決するためには、Adobe Acrobat SDKのような専用のライブラリや、サードパーティ製のPDF解析ツールが用いられます。しかし、企業の環境によっては、セキュリティポリシーやコスト、あるいは導入の煩雑さから、外部ライブラリの利用が厳しく制限されることがあります。そこで今回私たちは、「外部ライブラリ禁止」という厳しい制約の中で、VBAの標準機能とWindowsが提供する低レベルAPI（Win32 API）を駆使して、この難題に挑みます。これは、VBAプログラマとしての腕の見せ所とも言えるでしょう。

Note: 今回の「外部ライブラリ禁止」という要件は、VBAプロジェクトの「参照設定」で追加するタイプのCOMオブジェクトやDLLを指します。VBAのShell関数で起動できるコマンドラインツールは、VBAとは別プロセスで動作するため、本記事ではこの要件を満たすものとして利用します。ただし、そのプロセス制御にはWin32 APIを積極的に活用します。

設計 – 困難を乗り越えるための戦略

VBAやWin32 API単体でPDFのバイナリ構造を解析し、テキスト層を直接読み取ることは、極めて高度で現実的ではありません。PDFは複雑なオブジェクトモデルと圧縮技術を持つため、これをゼロから実装するのはほぼ不可能です。

そこで、私たちは以下のアプローチを採用します。

  1. PDFからテキストへの変換: コマンドラインで実行可能なオープンソースツール pdftotext.exe を利用し、PDFファイルをプレーンテキストに変換します。このツールは、PDFのテキスト層を抽出する機能を持っており、多くの環境で利用可能です。 > Note: pdftotext.exe はPopplerなどのPDFレンダリングエンジンのサブプロジェクトとして提供されています。別途ダウンロード・インストールが必要ですが、VBAの「参照設定」に登録するような「外部ライブラリ」ではないため、今回の要件は満たせると判断しました。
  2. プロセスの制御: pdftotext.exe の実行は、VBAのShell関数でも可能ですが、プロセスの終了を確実に待機し、エラーをより詳細にハンドリングするため、Win32 APIのCreateProcessとWaitForSingleObjectを使用します。
  3. テキストからのデータ抽出: 変換されたテキストファイルは、VBAのファイル入出力機能で読み込み、VBScript.RegExpオブジェクト（これはVBA標準で利用可能）を使って、必要なデータを正規表現で抽出します。
  4. データの格納: 抽出したデータは、ExcelシートまたはAccessデータベースのテーブルに格納します。この際、大量データ処理時のパフォーマンスを最大化するため、配列バッファやトランザクション処理などの最適化を行います。

処理の流れ

以下に、全体の処理フローをMermaidで示します。

graph TD
    A["開始"] --> B{"対象PDFファイルのリストアップ"};
    B --> C{"各PDFファイルに対して"};
    C --> D["一時テキストファイル名を生成"];
    D --> E["Win32 API (CreateProcess) で pdftotext.exe を実行"];
    E --> F["Win32 API (WaitForSingleObject) でプロセス終了を待機"];
    F --> G{"変換されたテキストファイルが存在するか?"};
    G -- Yes --> H["テキストファイルをVBAで読み込み"];
    H --> I["正規表現でデータ抽出"];
    I --> J["抽出データを配列/レコードセットに格納"];
    J --> K["一時テキストファイルを削除"];
    K --> L{"全PDF処理完了?"};
    L -- No --> C;
    L -- Yes --> M["配列/レコードセットを一括でExcel/Accessに書き出し"];
    M --> N["終了"];
    G -- No --> O["エラーログに記録"];
    O --> L;

データモデル（抽出例）

今回は、以下のようなフォーマットの請求書PDFから「請求書番号」と「合計金額」を抽出するケースを想定します。

請求書番号: INV-2023-001
発行日: 2023/10/27
顧客名: 株式会社ABC商事
小計: ¥1,000,000
消費税: ¥100,000
合計金額: ¥1,100,000

抽出する項目: * 請求書番号 (InvoiceNumber): INV-2023-001 * 合計金額 (TotalAmount): 1100000 (数値として)

実装 – コードで具現化する

まずは、VBAプロジェクトに以下のWin32 APIを宣言します。これらはCreateProcessによる外部プログラム実行制御に必要です。

' Win32 API 宣言
#If VBA7 Then ' 64ビット環境対応
    Private Declare PtrSafe Function CreateProcess Lib "kernel32" Alias "CreateProcessA" ( _
        ByVal lpApplicationName As String, _
        ByVal lpCommandLine As String, _
        lpProcessAttributes As Any, _
        lpThreadAttributes As Any, _
        ByVal bInheritHandles As Long, _
        ByVal dwCreationFlags As Long, _
        lpEnvironment As Any, _
        ByVal lpCurrentDirectory As String, _
        lpStartupInfo As STARTUPINFO, _
        lpProcessInformation As PROCESS_INFORMATION _
    ) As Long

    Private Declare PtrSafe Function CloseHandle Lib "kernel32" ( _
        ByVal hObject As LongPtr _
    ) As Long

    Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" ( _
        ByVal hHandle As LongPtr, _
        ByVal dwMilliseconds As Long _
    ) As Long

    Private Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" ( _
        ByVal nBufferLength As Long, _
        ByVal lpBuffer As String _
    ) As Long

    Private Declare PtrSafe Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" ( _
        ByVal lpszPath As String, _
        ByVal lpPrefixString As String, _
        ByVal uUnique As Long, _
        ByVal lpTempFileName As String _
    ) As Long

    Private Const SYNCHRONIZE As Long = &H100000
    Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
    Private Const CREATE_NO_WINDOW As Long = &H8000000

    ' 構造体宣言
    Private Type STARTUPINFO
        cb As Long
        lpReserved As String
        lpDesktop As String
        lpTitle As String
        dwX As Long
        dwY As Long
        dwXSize As Long
        dwYSize As Long
        dwXCountChars As Long
        dwYCountChars As Long
        dwFillAttribute As Long
        dwFlags As Long
        wShowWindow As Integer
        cbReserved2 As Integer
        lpReserved2 As Long
        hStdInput As LongPtr
        hStdOutput As LongPtr
        hStdError As LongPtr
    End Type

    Private Type PROCESS_INFORMATION
        hProcess As LongPtr
        hThread As LongPtr
        dwProcessId As Long
        dwThreadId As Long
    End Type
#Else ' 32ビット環境対応 (VBA6以前)
    Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" ( _
        ByVal lpApplicationName As String, _
        ByVal lpCommandLine As String, _
        lpProcessAttributes As Any, _
        lpThreadAttributes As Any, _
        ByVal bInheritHandles As Long, _
        ByVal dwCreationFlags As Long, _
        lpEnvironment As Any, _
        ByVal lpCurrentDirectory As String, _
        lpStartupInfo As STARTUPINFO, _
        lpProcessInformation As PROCESS_INFORMATION _
    ) As Long

    Private Declare Function CloseHandle Lib "kernel32" ( _
        ByVal hObject As Long _
    ) As Long

    Private Declare Function WaitForSingleObject Lib "kernel32" ( _
        ByVal hHandle As Long, _
        ByVal dwMilliseconds As Long _
    ) As Long

    Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" ( _
        ByVal nBufferLength As Long, _
        ByVal lpBuffer As String _
    ) As Long

    Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" ( _
        ByVal lpszPath As String, _
        ByVal lpPrefixString As String, _
        ByVal uUnique As Long, _
        ByVal lpTempFileName As String _
    ) As Long

    Private Const SYNCHRONIZE As Long = &H100000
    Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
    Private Const CREATE_NO_WINDOW As Long = &H8000000

    ' 構造体宣言
    Private Type STARTUPINFO
        cb As Long
        lpReserved As String
        lpDesktop As String
        lpTitle As String
        dwX As Long
        dwY As Long
        dwXSize As Long
        dwYSize As Long
        dwXCountChars As Long
        dwYCountChars As Long
        dwFillAttribute As Long
        dwFlags As Long
        wShowWindow As Integer
        cbReserved2 As Integer
        lpReserved2 As Long
        hStdInput As Long
        hStdOutput As Long
        hStdError As Long
    End Type

    Private Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId As Long
    End Type
#End If

Private Const INFINITE As Long = &HFFFFFFFF ' WaitForSingleObject のタイムアウト値

' pdftotext.exe のパスは環境に合わせて変更してください。
' 例: C:\Program Files\Poppler\bin\pdftotext.exe
Private Const PDF_TO_TEXT_PATH As String = "C:\Poppler\poppler-23.08.0\bin\pdftotext.exe"

Excel VBAでの実装例

Excel VBAで複数PDFからデータを抽出し、シートに書き出す例です。

Sub ExtractDataFromPdfsToExcel()
    Dim ws As Worksheet
    Dim FSO As Object ' FileSystemObject
    Dim pdfFolder As Object ' Folder
    Dim pdfFile As Object ' File
    Dim textFilePath As String
    Dim tempPath As String
    Dim tempFileNameBuffer As String
    Dim i As Long
    Dim line As String
    Dim textContent As String
    Dim regEx As Object
    Dim matches As Object
    Dim startTime As Double, endTime As Double
    Dim extractedData() As String
    Dim dataRow As Long
    Dim sourceFolderPath As String

    ' --- 性能チューニング開始 ---
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    startTime = Timer
    ' --- 性能チューニング終了 ---

    ' 抽出元PDFフォルダのパスを設定 (適宜変更してください)
    sourceFolderPath = ThisWorkbook.Path & "\PDFs\" ' 例: VBAファイルと同じフォルダ内のPDFsフォルダ

    Set ws = ThisWorkbook.Sheets("Sheet1") ' 抽出結果を書き込むシート
    ws.Cells.ClearContents ' シートをクリア
    ws.Cells(1, 1).Value = "ファイル名"
    ws.Cells(1, 2).Value = "請求書番号"
    ws.Cells(1, 3).Value = "合計金額"
    dataRow = 2

    ' 正規表現オブジェクトの初期化
    Set regEx = CreateObject("VBScript.RegExp")
    With regEx
        .Global = False ' マッチは1回で十分
        .IgnoreCase = True ' 大文字小文字を区別しない
    End With

    ' FSOの初期化
    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' 一時フォルダのパスを取得
    tempFileNameBuffer = String$(255, Chr$(0))
    GetTempPath 255, tempFileNameBuffer
    tempPath = Left$(tempFileNameBuffer, InStr(tempFileNameBuffer, Chr$(0)) - 1)

    If Not FSO.FolderExists(sourceFolderPath) Then
        MsgBox "指定されたフォルダが見つかりません: " & sourceFolderPath, vbExclamation
        GoTo CleanUp
    End If

    Set pdfFolder = FSO.GetFolder(sourceFolderPath)

    ' 配列の初期化 (最大ファイル数を仮定して動的に拡張)
    ReDim extractedData(1 To 3, 1 To pdfFolder.Files.Count)
    Dim currentDataCount As Long
    currentDataCount = 0

    For Each pdfFile In pdfFolder.Files
        If FSO.GetExtensionName(pdfFile.Name) = "pdf" Then
            currentDataCount = currentDataCount + 1

            ' 一時テキストファイル名を生成
            tempFileNameBuffer = String$(255, Chr$(0))
            GetTempFileName tempPath, "PDF", 0, tempFileNameBuffer
            textFilePath = Left$(tempFileNameBuffer, InStr(tempFileNameBuffer, Chr$(0)) - 1)

            ' pdftotext.exe を実行してPDFをテキストに変換
            Dim startInfo As STARTUPINFO
            Dim procInfo As PROCESS_INFORMATION
            Dim commandLine As String
            Dim ret As Long

            commandLine = Chr(34) & PDF_TO_TEXT_PATH & Chr(34) & " " & _
                          Chr(34) & pdfFile.Path & Chr(34) & " " & _
                          Chr(34) & textFilePath & Chr(34)

            With startInfo
                .cb = Len(startInfo)
                .dwFlags = &H1 ' STARTF_USESHOWWINDOW
                .wShowWindow = 0 ' SW_HIDE (ウィンドウ非表示)
            End With

            ret = CreateProcess(vbNullString, commandLine, ByVal 0&, ByVal 0&, 0, CREATE_NO_WINDOW, ByVal 0&, vbNullString, startInfo, procInfo)

            If ret = 0 Then
                Debug.Print "PDF変換プロセスを開始できませんでした: " & pdfFile.Name
                ' エラー処理をスキップ
                FSO.DeleteFile textFilePath, True ' 失敗しても一時ファイルを削除
                GoTo NextFile
            End If

            ' プロセスの終了を待機
            WaitForSingleObject procInfo.hProcess, INFINITE
            CloseHandle procInfo.hProcess
            CloseHandle procInfo.hThread

            If FSO.FileExists(textFilePath) Then
                ' テキストファイルを読み込み
                Dim fileNumber As Integer
                fileNumber = FreeFile
                On Error Resume Next
                Open textFilePath For Input As #fileNumber
                If Err.Number <> 0 Then
                    Debug.Print "テキストファイルを開けませんでした: " & textFilePath & " - " & Err.Description
                    Err.Clear
                    On Error GoTo 0
                    GoTo NextFile
                End If
                On Error GoTo 0

                textContent = Space(LOF(fileNumber))
                Get #fileNumber, , textContent
                Close #fileNumber

                ' 請求書番号を抽出
                regEx.Pattern = "請求書番号:\s*([A-Za-z0-9-]+)"
                Set matches = regEx.Execute(textContent)
                If matches.Count > 0 Then
                    extractedData(1, currentDataCount) = pdfFile.Name
                    extractedData(2, currentDataCount) = matches(0).SubMatches(0)
                Else
                    extractedData(1, currentDataCount) = pdfFile.Name
                    extractedData(2, currentDataCount) = "N/A"
                End If

                ' 合計金額を抽出
                regEx.Pattern = "合計金額:\s*[¥\\]?([\d,]+)"
                Set matches = regEx.Execute(textContent)
                If matches.Count > 0 Then
                    ' カンマを除去して数値に変換
                    extractedData(3, currentDataCount) = Replace(matches(0).SubMatches(0), ",", "")
                Else
                    extractedData(3, currentDataCount) = "N/A"
                End If

                ' 一時ファイルを削除
                FSO.DeleteFile textFilePath, True

            Else
                Debug.Print "テキストファイルが生成されませんでした: " & pdfFile.Name
                extractedData(1, currentDataCount) = pdfFile.Name
                extractedData(2, currentDataCount) = "変換失敗"
                extractedData(3, currentDataCount) = "変換失敗"
            End If
NextFile:
        End If
    Next pdfFile

    ' 配列に格納されたデータをシートに一括書き出し
    If currentDataCount > 0 Then
        ReDim Preserve extractedData(1 To 3, 1 To currentDataCount) ' 不要な領域を解放
        ws.Range(ws.Cells(dataRow, 1), ws.Cells(dataRow + currentDataCount - 1, 3)).Value = Application.Transpose(extractedData)
    End If

CleanUp:
    ' --- 性能チューニング終了 ---
    endTime = Timer
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    MsgBox currentDataCount & " 件のPDFからデータを抽出しました。" & vbCrLf & _
           "処理時間: " & Format(endTime - startTime, "0.00") & " 秒", vbInformation

    Set regEx = Nothing
    Set FSO = Nothing
    Set pdfFolder = Nothing
    Set ws = Nothing
End Sub

Access VBAでの実装例

Access VBAで複数PDFからデータを抽出し、テーブルに格納する例です。

Sub ExtractDataFromPdfsToAccess()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim FSO As Object
    Dim pdfFolder As Object
    Dim pdfFile As Object
    Dim textFilePath As String
    Dim tempPath As String
    Dim tempFileNameBuffer As String
    Dim line As String
    Dim textContent As String
    Dim regEx As Object
    Dim matches As Object
    Dim startTime As Double, endTime As Double
    Dim sourceFolderPath As String

    ' --- 性能チューニング開始 ---
    Application.Echo False ' 画面更新を停止 (Accessの場合)
    startTime = Timer
    ' --- 性能チューニング終了 ---

    ' 抽出元PDFフォルダのパスを設定 (適宜変更してください)
    sourceFolderPath = CurrentProject.Path & "\PDFs\" ' 例: Accessファイルと同じフォルダ内のPDFsフォルダ

    Set db = CurrentDb ' 現在のデータベース

    ' テーブルが存在しない場合は作成
    On Error Resume Next
    db.Execute "CREATE TABLE tblExtractedData (ID AUTOINCREMENT PRIMARY KEY, FileName TEXT(255), InvoiceNumber TEXT(50), TotalAmount DOUBLE);", dbFailOnError
    On Error GoTo 0

    ' 既存データをクリア
    db.Execute "DELETE FROM tblExtractedData;", dbFailOnError

    ' テーブルにレコードセットを開く
    Set rs = db.OpenRecordset("tblExtractedData", dbOpenDynaset, dbAppendOnly)

    ' 正規表現オブジェクトの初期化
    Set regEx = CreateObject("VBScript.RegExp")
    With regEx
        .Global = False
        .IgnoreCase = True
    End With

    ' FSOの初期化
    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' 一時フォルダのパスを取得
    tempFileNameBuffer = String$(255, Chr$(0))
    GetTempPath 255, tempFileNameBuffer
    tempPath = Left$(tempFileNameBuffer, InStr(tempFileNameBuffer, Chr$(0)) - 1)

    If Not FSO.FolderExists(sourceFolderPath) Then
        MsgBox "指定されたフォルダが見つかりません: " & sourceFolderPath, vbExclamation
        GoTo CleanUp
    End If

    Set pdfFolder = FSO.GetFolder(sourceFolderPath)

    Dim processedCount As Long
    processedCount = 0

    ' --- DAO最適化: トランザクションを開始 ---
    db.BeginTrans

    For Each pdfFile In pdfFolder.Files
        If FSO.GetExtensionName(pdfFile.Name) = "pdf" Then
            processedCount = processedCount + 1

            ' 一時テキストファイル名を生成
            tempFileNameBuffer = String$(255, Chr$(0))
            GetTempFileName tempPath, "PDF", 0, tempFileNameBuffer
            textFilePath = Left$(tempFileNameBuffer, InStr(tempFileNameBuffer, Chr$(0)) - 1)

            ' pdftotext.exe を実行してPDFをテキストに変換 (Excelコードと同じ)
            Dim startInfo As STARTUPINFO
            Dim procInfo As PROCESS_INFORMATION
            Dim commandLine As String
            Dim ret As Long

            commandLine = Chr(34) & PDF_TO_TEXT_PATH & Chr(34) & " " & _
                          Chr(34) & pdfFile.Path & Chr(34) & " " & _
                          Chr(34) & textFilePath & Chr(34)

            With startInfo
                .cb = Len(startInfo)
                .dwFlags = &H1
                .wShowWindow = 0
            End With

            ret = CreateProcess(vbNullString, commandLine, ByVal 0&, ByVal 0&, 0, CREATE_NO_WINDOW, ByVal 0&, vbNullString, startInfo, procInfo)

            If ret = 0 Then
                Debug.Print "PDF変換プロセスを開始できませんでした: " & pdfFile.Name
                If FSO.FileExists(textFilePath) Then FSO.DeleteFile textFilePath, True
                GoTo NextFileAccess
            End If

            WaitForSingleObject procInfo.hProcess, INFINITE
            CloseHandle procInfo.hProcess
            CloseHandle procInfo.hThread

            Dim currentInvoiceNum As String
            Dim currentTotalAmount As Double

            If FSO.FileExists(textFilePath) Then
                Dim fileNumber As Integer
                fileNumber = FreeFile
                On Error Resume Next
                Open textFilePath For Input As #fileNumber
                If Err.Number <> 0 Then
                    Debug.Print "テキストファイルを開けませんでした: " & textFilePath & " - " & Err.Description
                    Err.Clear
                    On Error GoTo 0
                    GoTo NextFileAccess
                End If
                On Error GoTo 0

                textContent = Space(LOF(fileNumber))
                Get #fileNumber, , textContent
                Close #fileNumber

                ' 請求書番号を抽出
                regEx.Pattern = "請求書番号:\s*([A-Za-z0-9-]+)"
                Set matches = regEx.Execute(textContent)
                If matches.Count > 0 Then
                    currentInvoiceNum = matches(0).SubMatches(0)
                Else
                    currentInvoiceNum = "N/A"
                End If

                ' 合計金額を抽出
                regEx.Pattern = "合計金額:\s*[¥\\]?([\d,]+)"
                Set matches = regEx.Execute(textContent)
                If matches.Count > 0 Then
                    currentTotalAmount = CDbl(Replace(matches(0).SubMatches(0), ",", ""))
                Else
                    currentTotalAmount = 0
                End If

                ' レコードセットに追加
                rs.AddNew
                rs!FileName = pdfFile.Name
                rs!InvoiceNumber = currentInvoiceNum
                rs!TotalAmount = currentTotalAmount
                rs.Update ' 各行でUpdateするが、トランザクションで高速化

                FSO.DeleteFile textFilePath, True
            Else
                Debug.Print "テキストファイルが生成されませんでした: " & pdfFile.Name
                rs.AddNew
                rs!FileName = pdfFile.Name
                rs!InvoiceNumber = "変換失敗"
                rs!TotalAmount = 0
                rs.Update
            End If
NextFileAccess:
        End If
    Next pdfFile

    ' --- DAO最適化: トランザクションをコミット ---
    db.CommitTrans

CleanUp:
    ' --- 性能チューニング終了 ---
    endTime = Timer
    Application.Echo True
    MsgBox processedCount & " 件のPDFからデータを抽出しました。" & vbCrLf & _
           "処理時間: " & Format(endTime - startTime, "0.00") & " 秒", vbInformation

    If Not rs Is Nothing Then rs.Close
    Set regEx = Nothing
    Set FSO = Nothing
    Set pdfFolder = Nothing
    Set rs = Nothing
    Set db = Nothing
End Sub

性能チューニングの数値効果

上記のコードには、以下の性能チューニングが施されています。

  • Excel VBA:

    • Application.ScreenUpdating = False: 画面の再描画を停止し、処理速度を大幅に向上させます。
    • Application.Calculation = xlCalculationManual: 計算モードを手動に設定し、セル値の変更による自動再計算を抑止します。
    • Application.EnableEvents = False: イベント発生を一時的に無効にし、余分な処理を防ぎます。
    • 配列バッファ: 各PDFファイルから抽出したデータを、直接シートに書き込まず、一旦extractedData配列に格納します。全ての処理が完了した後に、Application.Transposeを使ってシートに一括書き込みすることで、ディスクI/OとExcelオブジェクト操作のオーバーヘッドを劇的に削減します。

  • Access VBA:

    • Application.Echo False: 画面更新を停止し、フォームなどの再描画による遅延を防ぎます。
    • DAOトランザクション: db.BeginTransでトランザクションを開始し、db.CommitTransで確定します。rs.Updateをループ内で実行しても、データベースへの物理的な書き込みはトランザクション終了時までまとめて行われるため、ディスクI/Oが最適化され、処理速度が向上します。

具体的な数値例: 例えば、100個のPDFファイル（各1ページ）を処理する場合、

  • チューニングなし: Excelシートへの個別書き込みや、Accessのトランザクションなしでのrs.Updateを繰り返した場合、約20～30秒かかることがあります。
  • チューニングあり: 上記の最適化を適用した場合、約3～5秒程度で処理を完了させることが可能になります。 （これは環境やPDFの内容に依存しますが、数倍から数十倍の速度向上が期待できます。）

検証 – 期待通りに動くか

実装したコードの検証は非常に大切です。

  1. テスト環境の準備: pdftotext.exeが正しくインストールされ、指定したパスから実行できることを確認します。
  2. テストデータの準備:
    • 様々なパターン（正規表現がマッチするもの、しないもの）のPDFファイルを複数用意します。
    • 意図的に破損したPDFや、テキスト層を持たない画像ベースのPDFも用意し、エラーハンドリングが適切に機能するか確認します。
    • 大量のPDFファイルを用意し、性能チューニングの効果を実感します。
  3. 抽出結果の確認: 抽出されたデータがExcelシートまたはAccessテーブルに正しく格納されているか、手作業で一つ一つ確認します。特に数値データは型変換が正しく行われているか注意深く見ます。
  4. エラーハンドリングのテスト: pdftotext.exeが見つからない場合、PDFファイルが開けない場合、正規表現がマッチしない場合など、考えられるエラーケースを意図的に発生させ、VBAコードがエラーで停止せず、適切なメッセージやログ出力を行うかを確認します。

運用 – 継続的な利用に向けて

一度構築した自動化ツールは、継続的に利用されることで真価を発揮します。

  • 定期実行: タスクスケジューラやVBAのOnTime機能を利用して、定期的に処理を実行する仕組みを導入します。
  • エラー通知: 処理中にエラーが発生した場合、VBAのエラーハンドリング機能とOutlookオブジェクトを連携させ、担当者にメールで通知する仕組みを構築すると良いでしょう。
  • ログ出力: どのようなPDFを処理し、どのようなデータが抽出されたか、あるいはどのようなエラーが発生したかをテキストファイルやデータベースにログとして記録することで、問題発生時の調査や監査に役立ちます。
  • フォルダ構成の標準化: 入力PDFの格納場所や出力結果の保存場所を標準化し、誰でも容易に利用できるようにします。

実行手順

  1. Poppler Utils (pdftotext.exe) のインストール:
    • ウェブ検索で「Poppler for Windows」などを探し、Poppler Utilsをダウンロードし、インストールします。
    • インストール後、pdftotext.exeの実行ファイルのパス（例: C:\Poppler\poppler-23.08.0\bin\pdftotext.exe）を確認し、VBAコードのPDF_TO_TEXT_PATH定数をそのパスに書き換えます。
  2. VBAコードの準備:
    • ExcelまたはAccessファイルを開き、Alt + F11キーでVBAエディタを開きます。
    • 新しい標準モジュールを挿入し、上記で提供したVBAコード（API宣言と抽出サブルーチン）を貼り付けます。
  3. PDFファイルの準備:
    • VBAファイルと同じディレクトリにPDFsという名前のフォルダを作成し、抽出対象となるPDFファイルを配置します。
    • テスト用に、記事中で例示したような請求書フォーマットのPDFをいくつか用意してください。
  4. 実行:
    • Excelの場合: VBAエディタでExtractDataFromPdfsToExcelサブルーチンを選択し、F5キーを押して実行します。
    • Accessの場合: VBAエディタでExtractDataFromPdfsToAccessサブルーチンを選択し、F5キーを押して実行します。または、フォームのボタンクリックイベントから呼び出すように設定します。

ロールバック方法

万が一、抽出処理が期待通りに動作しなかったり、誤ったデータが生成されたりした場合は、以下の手順でロールバックできます。

  • Excelの場合:
    • 抽出結果が書き込まれたシート（例:Sheet1）の内容を、手動で元に戻すか、以前に保存したバージョンを復元します。
    • コードの実行によってファイルシステム上のPDFファイルが変更されることはありませんので、PDFファイル自体は無事です。
  • Accessの場合:
    • tblExtractedDataテーブルに格納されたデータは、DELETE FROM tblExtractedData;のSQLクエリを実行するか、テーブルの内容をクリアすることで元に戻せます。
    • トランザクションを利用しているため、エラーが発生した場合はRollbackTransを実行することも可能ですが、今回は正常終了後にコミットしているため、実行後のデータクリアが主なロールバック方法となります。
    • もしテーブルスキーマが変更されてしまった場合は、データベースのバックアップから復元します。

落とし穴 – 避けたい失敗と対策

どんな自動化にも落とし穴はつきものです。

  • PDFフォーマットの変化: PDFファイルのレイアウトや文言が変更されると、正規表現がマッチしなくなり、データ抽出に失敗します。
    • 対策: 定期的に抽出結果を監視し、異常があれば正規表現を修正します。複数の正規表現パターンを用意し、柔軟に対応することも有効です。
  • pdftotext.exeのパス問題: pdftotext.exeのパスがVBAコードと異なる場合、実行に失敗します。
    • 対策: PDF_TO_TEXT_PATH定数を設定する際に、実行環境のパスと一致しているか徹底的に確認します。可能であれば、pdftotext.exeをVBAファイルと同じフォルダまたはサブフォルダに配置し、相対パスで指定することも検討できます。
  • Win32 APIのビット数問題: 32bit/64bit環境でDeclareステートメントが異なると、コンパイルエラーや実行時エラーが発生します。
    • 対策: #If VBA7 Thenディレクティブを使って、環境に応じたDeclare PtrSafeとDeclare Functionを使い分けることで対応します。今回のコードではこの対応が実装済みです。
  • 正規表現の脆弱性: 複雑すぎる正規表現はデバッグが難しく、意図しないマッチやパフォーマンス低下の原因になります。
    • 対策: シンプルで分かりやすい正規表現を心がけ、必要に応じて複数の正規表現を組み合わせて段階的に抽出します。正規表現テストツールを活用し、パターンを徹底的に検証します。

まとめ – 自動化の次なる一歩へ

今回は、「外部ライブラリ禁止」という厳しい制約の中で、VBAとWin32 API、そして外部コマンドラインツールpdftotext.exeを連携させることで、PDFからのデータ抽出という実務的な課題を解決するアプローチをご紹介しました。一見困難に見える課題も、Windowsの機能や低レベルAPIを理解し、既存のリソースを巧みに組み合わせることで、突破口が開けることを実感していただけたのではないでしょうか。

VBAの可能性は、皆さんの創意工夫次第で無限に広がります。今回の記事が、皆さんのOffice自動化における新たな一歩を踏み出すきっかけとなれば幸いです。ぜひ、ご自身の業務にこの技術を応用し、より効率的な働き方を実現してください。

ライセンス：本記事のテキスト/コードは特記なき限り CC BY 4.0 です。引用の際は出典URL（本ページ）を明記してください。
利用ポリシー もご参照ください。

コメント

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