使用Excel VBA在Word中打开受密码保护的pdf

时间:2018-12-27 18:11:13

标签: excel vba ms-word

我有一个宏,可以在Word中打开PDF,但是PDF受密码保护。我还具有VBA代码,可在弹出的对话框中输入密码,但是该代码在输入密码之前停止。如果我手动输入密码,密码会继续,但是我希望使用我已有的密码自动输入密码。

    Option Explicit

    #If VBA7 And Win64 Then
    Public Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Public Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
   #Else
    Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Public Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
Public Const SW_HIDE As Long = 0
Public Const SW_SHOWNORMAL As Long = 1
Public Const SW_SHOWMAXIMIZED As Long = 3
Public Const SW_SHOWMINIMIZED As Long = 2
Public Const WM_SETTEXT = &HC
Public Const VK_RETURN = &HD
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101

Public Sub OpenLockedPdf() 'Password As String)

    #If VBA7 And Win64 Then
        Dim parentWindow            As LongPtr
        Dim firstChildWindow        As LongPtr
        Dim secondChildFirstWindow  As LongPtr
        Dim secondChildSecondWindow  As LongPtr
    #Else
        Dim parentWindow            As Long
        Dim firstChildWindow        As Long
        Dim secondChildFirstWindow  As Long
        Dim secondChildSecondWindow  As Long
    #End If
    Dim timeCount                   As Date
    'Find the handle of the pop-up window.

    Dim Word As New Word.Application
    Dim WordDoc As New Word.Document
    Dim Doc_Path As String
    Dim Password As String
    Doc_Path = "Examplepdf.PDF"
    Set WordDoc = Word.Documents.Open(Filename:=Doc_Path, Format:="PDF Files", ConfirmConversions:=False)
    Password = "Password"
    timeCount = Now()
    Do Until Now() > timeCount + TimeValue("00:00:05")
        parentWindow = 0
        DoEvents
        parentWindow = FindWindow("NUIDialog", "Password")
        If parentWindow <> 0 Then Exit Do
    Loop
    If parentWindow <> 0 Then

        'Find the handle of the first child window (it is a group box).
        timeCount = Now()
        Do Until Now() > timeCount + TimeValue("00:00:05")
            firstChildWindow = 0
            DoEvents
            firstChildWindow = FindWindowEx(parentWindow, ByVal 0&, "NetUIHWND", vbNullString)
            If firstChildWindow <> 0 Then Exit Do
        Loop
        If firstChildWindow <> 0 Then
            timeCount = Now()
            Do Until Now() > timeCount + TimeValue("00:00:05")
                secondChildFirstWindow = 0
                DoEvents
                secondChildFirstWindow = FindWindowEx(firstChildWindow, ByVal 0&, "NetUICtrlNotifySink", vbNullString)
                If secondChildFirstWindow <> 0 Then Exit Do
            Loop
            If secondChildFirstWindow <> 0 Then
                timeCount = Now()
                Do Until Now() > timeCount + TimeValue("00:00:05")
                    secondChildSecondWindow = 0
                    DoEvents
                    secondChildSecondWindow = FindWindowEx(secondChildFirstWindow, ByVal 0&, "RICHEDIT60W", vbNullString)
                    If secondChildSecondWindow <> 0 Then Exit Do
                Loop
                If secondChildSecondWindow <> 0 Then
                    'Fill the password in the text box.
                    SendMessage secondChildSecondWindow, WM_SETTEXT, 0&, ByVal Password
                    'Press the OK button (it is the default action, so no need to find the handle of the button).
                    PostMessage secondChildSecondWindow, WM_KEYDOWN, VK_RETURN, 0
                    PostMessage secondChildSecondWindow, WM_KEYUP, VK_RETURN, 0
                End If
            End If
        End If
    End If

End Sub

0 个答案:

没有答案