テスト87

```vb
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解除3()
'-----------------------
'参照設定：Acrobat(Adobe Acrobat 10.0 Type Library)
'有料のAcrobat Proを使えるようにしておく必要がある
'-----------------------
'メモ
'テスト85の応用
'複数のPW付PDFファイルを一括でパスワード無しPDFとして
'保存する。...〆(･ω･´)ﾒﾓﾒﾓ
'-----------------------
Dim FSO As Variant
Dim objWSH As Object
Dim edt_hwnd   As Long
Dim hWnd As Long
Dim btn_hwnd As Long
Dim strPassword As String
Dim strFileName As String
Dim PDF_File As Variant
Dim PdfFilePath As String
Dim str As String
Dim Set_flg As Boolean
'--------------------------------------
'初期設定
Set FSO = CreateObject("Scripting.FileSystemObject")

Set objWSH = CreateObject("Wscript.Shell")

Set_flg = False

With ThisWorkbook.Sheets("ファイル名")

    strPassword = Trim(.Range("D1"))
    PdfFilePath = Trim(.Range("D2"))

End With

'--------------------------------------
ChDrive "C"
ChDir "C:\Users\User\Desktop\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

    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

    ActivePrinter = "Microsoft Print to PDF on Ne01:"

    str = "Acrobat.exe /t" & " " & PDF_File.Path
    objWSH.Run str   '印刷ダイアログボックスが表示される

    hWnd = 0
    
    '[印刷結果を名前を付けて保存]のダイアログボックスが表示されるまで待機
    Do Until hWnd <> 0
    
        hWnd = FindWindow(vbNullString, "印刷結果を名前を付けて保存")
        '処理待ち
        Sleep (50)
    
        DoEvents
    
    Loop

    '[シートでファイル名をつくる]
    With ThisWorkbook.Sheets("ファイル名")
    
        .Range("A1").Clear
        .Range("A1").Value = FSO.GetBaseName(PDF_File.Path) & "_解除.pdf"
        .Range("A1").Copy
    
    End With
    
    '[Sendkeysで名前を貼り付け、Enter]
    Sleep 500
    objWSH.SendKeys "^(V)", True
    Sleep 500
    '----------------------------
    '表示されるダイアログボックスは事前にChDirで保存先を指定しても、その保存先が
    '最初に表示されない。そのため、最初に一度だけユーザーに手動で設定してもらう
    '----------------------------
    If Set_flg = False Then
    
        Do Until hWnd = 0
        
            hWnd = FindWindow(vbNullString, "印刷結果を名前を付けて保存")
            '処理待ち
            Sleep (50)
        
            DoEvents
        
        Loop
    
        Set_flg = True
 
    End If

    objWSH.SendKeys "^(S)", True
    Sleep 500
    objWSH.SendKeys "{ENTER}", True
    Sleep 500
    objWSH.SendKeys "{ENTER}", True
  
Next PDF_File
  
'--------------------------------------

Set objWSH = Nothing
Set FSO = Nothing

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

End Sub