業務改善 Excel VBA マクロ PDF取り込み

業務改善 Excel VBA マクロ PDF取り込み

PDFをWordで自動変換し、その情報をもとにテキストファイル(Hoge.txt)形式で出力するコードと変換時に出力する確認ログの自動オン・オフのコードを下記に記載します。

このコードを流用してに特定の文字の後や特定パターンで配置されている文字列の取得して書類の作成やダブルチェックなどが出来ると思います。
またコードの後に業務で使用した際の注意点も記載しますので良ければ、そちらも参照して下さい。

Sub ConvertPDFtoText()

    Dim wordApp As Object
    Dim wordDoc As Object
    Dim pdfPath As String               ' 手動で指定するPDFファイルへのパス
    Dim wordText As String              ' wordから読み取った全ての情報を格納する
    Dim textLines As Variant            ' wordから読み取った情報を改行で区切ったものを格納する変数
    Dim i As Long
    Dim wordVer As String
    Dim fNum As Integer

    ' PDFファイルを選択
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "PDFファイルを選択してください"
        .Filters.Clear
        .Filters.Add "PDFファイル", "*.pdf"
        If .Show = -1 Then
            pdfPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    ' Wordアプリケーションを作成
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True

    ' Wordバージョンを取得
    wordVer = wordApp.Application.Version

    ' 警告を無効化
    Call SetRegValue("DisableConvertPdfWarning", 1, wordVer)

    ' PDFを開く
    Set wordDoc = wordApp.Documents.Open(fileName:=pdfPath, ConfirmConversions:=False, ReadOnly:=False)

    If Not wordDoc Is Nothing Then
        DoEvents   ' Word側の変換処理を待つ
        wordText = wordDoc.Content.text

        ' 改行を一度 vbCrLf に統一(必要に応じて特殊文字を半角スペース等に変換して下さい)
        wordText = Replace(wordText, "", "")
        wordText = Replace(wordText, vbCrLf, vbLf)
        wordText = Replace(wordText, vbCr, vbLf)
        wordText = Replace(wordText, vbLf, vbCrLf)
 
        ' 改行で分割
        textLines = Split(wordText, vbCrLf)

        ' テキストファイルに書き込み開始(Excelファイルと同一ディレクトリに配置する仕様とする)
        fNum = FreeFile
        'Open "./hoge.txt" For Output As #fNum  'PDFファイルと同一ディレクトリにtxtファイルを配置する場合はこちらを使用
        Open ThisWorkbook.Path & "\hoge.txt" For Output As #fNum

        For i = LBound(textLines) To UBound(textLines)
            If Len(Trim(textLines(i))) > 0 Then
                'Debug.Print i & " : " & textLines(i)
                Print #fNum, i & " : "; textLines(i)
            End If
        Next i

        Close #fNum   ' ファイルを閉じる
        wordDoc.Close SaveChanges:=False   'wordを保存をせず閉じる処理

    End If

    ' 警告を元に戻す
    Call SetRegValue("DisableConvertPdfWarning", 0, wordVer)
    
    'wordアプリを閉じる
    wordApp.Quit
    Set wordDoc = Nothing
    Set wordApp = Nothing

    MsgBox "成功しました"
    
End Sub

 

'wordを開いた際に表示されるメッセージボックスの有効化・無効化関数 ※レジストリの値を設定（数値型）

Sub SetRegValue(Name As String, newValue As Long, wordVer As String)

    Dim wshShell As Object
    Dim regKey As String

    Set wshShell = CreateObject("WScript.Shell")
    regKey = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\" & wordVer & "\Word\Options\"

    wshShell.RegWrite regKey & Name, newValue, "REG_DWORD" 'RegWriteメソッドでレジストリを設定
    Set wshShell = Nothing

End Sub

以上がベースとなるコードになります。

このPDF取込の注意点ですが、

・PDFによって特殊文字・特殊改行がある場合(VBA上では矢印や♠マーク表記になっていたりするため要注意)
・PDF形式では確認できない箇所への改行が混在または改行自体ない場合もある
・現状のコードではテキストボックス化された文字列や画像データそのものとして埋め込まれた情報は取得できない。(テキストボックスに関しては仕様上自体は可能らしい)
・改行⇒スペース⇒改行となる可能性が混在し、完全に特定の文字列の後にある文字列を取得する処理の場合は事前に除去が必要になります。

そのため、下記のコードも組み込むと追い場合もあります

        ' 改行を一度 vbCrLf に統一
        wordText = Replace(wordText, "矢印マーク", "")       '特殊文字(出力時では半角スペースに似てるが異なる)
        wordText = Replace(wordText, "スペードマーク", "")   '納品書に含まれる特殊改行文字の除去
        wordText = Replace(wordText, "    ", " ")           ' 特殊なTAB(?)を半角スペースに変換(現時点では必要性が不明)

        wordText = Replace(wordText, vbTab, " ")    ' TABを半角ベースに変換(こちらは必須)
        wordText = Replace(wordText, vbCrLf, vbLf)
        wordText = Replace(wordText, vbCr, vbLf)
        wordText = Replace(wordText, vbLf, vbCrLf)

       

        ' 連続改行を1つにまとめる
        Do While InStr(wordText, vbCrLf & vbCrLf) > 0
            wordText = Replace(wordText, vbCrLf & vbCrLf, vbCrLf)
        Loop
        Do While InStr(wordText, vbCrLf & vbCrLf) > 0
            wordText = Replace(wordText, vbCrLf & " " & vbCrLf, vbCrLf)
        Loop
 

        ' 改行で分割
        textLines = Split(wordText, vbCrLf)

急ぎで作ったためPDF等は省略します。
時間があったり、要望があれば検討します
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 以上