Automating Print dialog for AcroPDF to XPS API

[Craggs82]

Hello all,

I'm currently working on a system to print down specific pages from a PDF file loaded into a webbrowser control on a userform into the XPS document writer.

I've managed to cahnge the default printer, reference the pdf, run the printpages function and (sometimes) automate the printing dialog boxes that appear (including Adobes "this may print the whole document" warning).

My issue is that my code is unstable at best, for some users its runs fine, for others it hangs badly. In some cases it simply does nothing at all.

Below is the automation code, I was hoping that someone with a bit more experience than myself could point me in the right direction for stabilizing this beast. I particularly feel that my findwindowsEX is sloppy at best.

All critique is welcome!

Thanks in advance

Option Explicit

Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As Any, ByVal lpWindowName As Any) 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 SendMessageByString Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
    
Public Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
    
Public Const BM_CLICK = &HF5
Public Const BM_GETCHECK = &HF0&
Public Const WM_SETTEXT = &HC

Sub Adobe_Warning_Click_Yes()
    
    Dim hwnd As Long
    Dim hwnd2 As Long
    Dim hWnd3 As Long
    Dim filename As String
    Dim cipher As String
    
    On Error GoTo Handle
    
    With Application
        .Interactive = False
        .ScreenUpdating = False
    End With
    
    cipher = UCase(Environ("UserName"))
    
    filename = "C:\Stuff\Things\" & cipher & ".xps"
    
    Do
        
        hwnd = FindWindow("#32770", "Adobe Reader")
        hwnd2 = FindWindow("#32770", "Save the file as")
        
        DoEvents
        
    Loop Until hwnd Or hwnd2 'i should probably put a timeout on here

    If hwnd Then
    
            Application.Wait (Now + TimeValue("0:00:02"))
            
            hwnd = FindWindowEx(hwnd, 0, "GroupBox", "")
            
            hwnd2 = FindWindowEx(hwnd, 0, "Button", "Yes")
            
            hWnd3 = FindWindowEx(hwnd, 0, "Button", "Do &not show this message again")
            
            DoEvents
            
            If CBool(SendMessage(hWnd3, BM_GETCHECK, 0, 0)) = False Then SendMessage hWnd3, BM_CLICK, 0, 0
            
            DoEvents
            
            SendMessage hwnd2, BM_CLICK, 0, 0
        
            hwnd2 = 0
            
            Do
                
                hwnd2 = FindWindow("#32770", "Save the file as")
            
            Loop Until hwnd2
            
    End If
       
    If hwnd2 Then
            
            Application.Wait (Now + TimeValue("0:00:02"))
            
            hwnd = hwnd2
            
            hwnd2 = 0
            
            hwnd2 = FindWindowEx(hwnd, 0, "DUIViewWndClassName", "")

            hwnd2 = FindWindowEx(hwnd2, 0, "DirectUIHWND", "")

            hwnd2 = FindWindowEx(hwnd2, 0, "FloatNotifySink", "")

            hwnd2 = FindWindowEx(hwnd2, 0, "ComboBox", "")
                        
            hWnd3 = FindWindowEx(hwnd, 0, "Button", "&Save")
            
            DoEvents
            
            Call SendMessageByString(hwnd2, WM_SETTEXT, 0, filename)
            
            SendMessage hWnd3, BM_CLICK, 0, 0
            
    End If
    

Handle:

    With Application
        .Interactive = True
        .ScreenUpdating = True
    End With
    
    
End Sub

 

[Craggs82]

apologies for the distinctly un-annotated code. I'll try again.

Option Explicit

Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As Any, ByVal lpWindowName As Any) 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 SendMessageByString Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
    
Public Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
    
Public Const BM_CLICK = &HF5
Public Const BM_GETCHECK = &HF0&
Public Const WM_SETTEXT = &HC

Sub Adobe_Warning_Click_Yes()
    
    Dim hwnd As Long
    Dim hwnd2 As Long
    Dim hWnd3 As Long
    Dim filename As String
    Dim cipher As String
    
    On Error GoTo Handle
    
    With Application
        .Interactive = False   'this is essentially redundant. I was using BLOCKINPUT but 99% of users do not have admin privileges. This seems to do nothing at all.
        .ScreenUpdating = False
    End With
    
    cipher = UCase(Environ("UserName"))
    
    filename = "C:\Stuff\Things\" & cipher & ".xps"    'needs the full path or will save in wherever default 'save as' leads.
    

    Do 'loops until finding either the adobe warning or the xps save as dialog.
        
        hwnd = FindWindow("#32770", "Adobe Reader")
        hwnd2 = FindWindow("#32770", "Save the file as")
        
        DoEvents
        
    Loop Until hwnd Or hwnd2    'I should probably put a timeout on here

	

    If hwnd Then 'found Adobe warning
    
            Application.Wait (Now + TimeValue("0:00:02")) 'this wait seems vital to allow the system time to process the hwnd. Same as below.
            
            hwnd = FindWindowEx(hwnd, 0, "GroupBox", "")
            
            hwnd2 = FindWindowEx(hwnd, 0, "Button", "Yes")    'yes (close) button
            
            hWnd3 = FindWindowEx(hwnd, 0, "Button", "Do &not show this message again")    '"do not show again" checkbox
            
            DoEvents
            
            If CBool(SendMessage(hWnd3, BM_GETCHECK, 0, 0)) = False Then SendMessage hWnd3, BM_CLICK, 0, 0  'checks the "Do not show me this warning" box is ticked. if not, ticks it. 
            
            DoEvents
            
            SendMessage hwnd2, BM_CLICK, 0, 0 'closes the warning.
        
            hwnd2 = 0
            
            Do
                
                hwnd2 = FindWindow("#32770", "Save the file as")    ' finding the save as window
            
            Loop Until hwnd2
            
    End If
       
    If hwnd2 Then
            
            Application.Wait (Now + TimeValue("0:00:02"))
            
            hwnd = hwnd2
            
            hwnd2 = 0
            
            hwnd2 = FindWindowEx(hwnd, 0, "DUIViewWndClassName", "")

            hwnd2 = FindWindowEx(hwnd2, 0, "DirectUIHWND", "")

            hwnd2 = FindWindowEx(hwnd2, 0, "FloatNotifySink", "")

            hwnd2 = FindWindowEx(hwnd2, 0, "ComboBox", "")   'filename box
                        
            hWnd3 = FindWindowEx(hwnd, 0, "Button", "&Save")   'save button
            
            DoEvents
            
            Call SendMessageByString(hwnd2, WM_SETTEXT, 0, filename)   'sets filename
            
            SendMessage hWnd3, BM_CLICK, 0, 0   'clicks save
            
    End If
    

Handle:

    With Application
        .Interactive = True
        .ScreenUpdating = True
    End With
    
    
End Sub

 

[Craggs82]

Ok so after much investigation it appears that the hanging print was nothing to do with my code and is, in fact, a feature of Adobe Reader that causes the first print of the day to hang up a users system for up to a minute. how these people still get away with this is beyond me.

Oh well, I'll leave this here for posterity, hopefully it may be of some use to someone sometime.