Public Sub PW付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
'-----------------------
'メモ
'テスト74の応用
'パスワード付PDFを開いて、それを1ページずつ
'パスワード無しPDFとして分割して出力する。...〆(･ω･´)ﾒﾓﾒﾓ
'-----------------------

Dim jso As Variant
Dim i As Long
Dim fp As String
Dim fn As String
Dim FSO As Variant
Dim objWSH As Object
Dim Limit As Date
Dim hwnd As Long
Dim edt_hwnd As Long
Dim btn_hwnd As Long
Dim strPassword As String
Dim strFileName As String

'--------------------------------------
'初期設定
'PDFファイルのパスワード
strPassword = "111111"

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

Set objWSH = CreateObject("Wscript.Shell")
'PDFファイルオープン
objWSH.Run """" & PdfFilePath & """", 1

'--------------------------------------
'パスワードダイアログのハンドル取得
Do Until hwnd <> 0

    hwnd = FindWindow("#32770", "パスワード")
    '処理待ち
    Sleep (50)
    
    DoEvents
    
Loop

hwnd = FindWindowEx(hwnd, 0&, "GroupBox", vbNullString)


'パスワード入力欄のハンドル取得
edt_hwnd = FindWindowEx(hwnd, 0&, "RICHEDIT50W", vbNullString)
'OKボタンのハンドル取得
btn_hwnd = FindWindowEx(hwnd, 0&, "Button", "OK")

If (edt_hwnd <> 0) And (btn_hwnd <> 0) Then

    'パスワード送信
    Call SendMessage(edt_hwnd, WM_SETTEXT, 0&, strPassword)
    
    'OKボタンをクリック処理
    Call SendMessage(btn_hwnd, WM_ACTIVATE, 1, 0&)
    Call SendMessage(btn_hwnd, BM_CLICK, 0, 0&)

End If

'--------------------------------------
'PDFの処理
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

Set FSO = CreateObject("Scripting.FileSystemObject")

'フォルダパスとファイル名取得
With FSO

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

'Acrobatを起動
Ret = objAcroApp.Show

Ret = objAcroAVDoc.Open(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

            CallByName jso, "extractPages", VbMethod, _
                        i, i, fp & fn & "(" & i + 1 & ").pdf"
        Next
        
        .Close
    
    End If
  
End With

'--------------------------------------

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

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

End Sub
 
Private Function Getfolpath(ByVal str As String)
  If Right(str, 1) <> ChrW(92) Then str = str & ChrW(92)
  Getfolpath = str
End Function