テスト74

Public Sub PDF分割()
'-----------------------
'参照設定：Acrobat(Adobe Acrobat 10.0 Type Library)
'有料のAcrobat Proを使えるようにしておく必要がある
'-----------------------
'主な参考サイト様(以下のサイト以外にもたくさん確認しました。)
'初心者備忘録beginner's memo
'https://www.ka-net.org/blog/?p=7293

'VBA(Excel)からAcrobat経由でPDFをプログラミング操作(OLE:IAC)する
'http://pdf-file.nnn2.com/?p=93
'-----------------------
'メモ
'業務上、PDF分割の処理が必要になった。しかし、上記のサイト様を含めて
'いろんなサイトを調べたり参考コードを試してみたが、そのままではどうしても
'処理できなかった(ページ数がカウントできない、ページ削除できない、エラーが出るetc・・・)
'そのため､色々試行錯誤したところ今回のコードでPDF分割できた。
'ポイントのひとつは分割処理の前に分割元のPDFファイルを開くこと。
'処理の内容は対象のPDFを1ページずつ分割する。...〆(･ω･＊)ﾒﾓﾒﾓ
'-----------------------
Dim jso As Variant
Dim i As Long
Dim fp As String
Dim fn As String
Dim FSO As Variant

Const PdfFilePath = "C:\Users\User\Desktop\VBA練習\PDF\分割\test.pdf"

Set FSO = CreateObject("Scripting.FileSystemObject")
'フォルダパスとファイル名取得
With FSO

    fp = Getfolpath(.GetParentFolderName(PdfFilePath))
    fn = .GetBaseName(PdfFilePath)
  
End With


Dim objAcroApp As New Acrobat.AcroApp
Dim objAcroAVDoc As New Acrobat.AcroAVDoc
Dim objAcroPDDoc As Acrobat.AcroPDDoc
Dim PageCount As Long
Dim Ret  As Long

'Acrobatを起動
Ret = objAcroApp.Show

'PDFファイルを開いて表示する(←Acrobatは開くが指定のPDFファイルまでは開かない)
Ret = objAcroAVDoc.Open(PdfFilePath, "")

'分割元のPDFファイルを開く(ここがポイント)
CreateObject("Shell.Application").ShellExecute PdfFilePath

'PDDocを取得
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc

'ページ数を取得
PageCount = objAcroPDDoc.GetNumPages()


With CreateObject("AcroExch.PDDoc")

    If .Open(PdfFilePath) = True Then
    
        Set jso = .GetJSObject
        
        For i = 0 To PageCount - 1
        'ポイントは、分割元のPDFファイルを開いておく必要がある
'        (開かれていないと以下のコードの部分でエラーになってしまう)
            CallByName jso, "extractPages", VbMethod, _
                        i, i, fp & fn & "(" & i + 1 & ").pdf"
        Next
        
        .Close
    
    End If
  
End With


Set FSO = Nothing
Set objAcroApp = Nothing
Set objAcroAVDoc = Nothing
Set objAcroPDDoc = Nothing
Set jso = Nothing

MsgBox "処理が終了しました。", vbInformation

End Sub