テスト85

Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lparam As Any) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const BM_CLICK As Long = &HF5
Public Const WM_ACTIVATE As Long = &H6
Public Const WM_SETTEXT As Long = &HC
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
'-----------------------
'テスト75の応用
'複数のPW付PDFファイルを一括でパスワード無し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
Dim PDF_File As Variant
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
Dim PdfFilePath As String
Dim Output_path As String
'--------------------------------------
'初期設定
'PDFファイルのパスワード
strPassword = "111111"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objWSH = CreateObject("Wscript.Shell")
PdfFilePath = "C:\Users\User\Desktop\VBA関連\VBA練習\PW付PDF\"
Output_path = "C:\Users\User\Desktop\VBA関連\VBA練習\PW付PDF\出力先\"
'--------------------------------------
For Each PDF_File In FSO.GetFolder(PdfFilePath).Files
    'PDFファイルオープン
    objWSH.Run """" & PDF_File.Path & """", 1
    hwnd = 0
    'パスワードダイアログのハンドル取得
    Do Until hwnd <> 0
        hwnd = FindWindow("#32770", "パスワード")
        '処理待ち
        Sleep (50)
        DoEvents
    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の処理
    'ファイル名取得
    With FSO
        fn = .GetBaseName(PDF_File.Name)
    End With
    '2023/1/31 コメント化 -------------
    'Acrobatを起動
'    Ret = objAcroApp.Show
'    Ret = objAcroAVDoc.Open(PDF_File.Path, "")
    'PDDocを取得
'    Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
    '2023/1/31 追加-----------------------
    Set objAcroAVDoc = objAcroApp.GetAVDoc(0)
    '--------------------------------------
    With CreateObject("AcroExch.PDDoc")
        If .Open(PDF_File.Path) = True Then
            Set jso = .GetJSObject
            CallByName jso, "extractPages", VbMethod, _
                        0, 0, Output_path & fn & "_" & "PW解除.pdf"
            .Close
        End If
    End With
Next PDF_File
'--------------------------------------
Set objWSH = Nothing
Set FSO = Nothing
Set objAcroApp = Nothing
Set objAcroAVDoc = Nothing
Set objAcroPDDoc = Nothing
Set jso = Nothing
MsgBox "処理が終了しました。", vbInformation
End Sub