VBA Outlook Print to PDF - NOT "SAVE"-CodePudding

App Versions:

Outlook: Microsoft 365 Apps for enterprise
Adobe Acrobat Pro DC: version 2022.001.20117

#########################################################################
DISCLAIMER: MY COMPANY HAS DISABLED "SAVE AS" FUNCTIONALITY WITHIN OUTLOOK.
PLEASE DO NOT SUGGEST ANY VBA METHODS THAT INVOLVE ".SaveAs", BECAUSE THEY
DO NOT WORK.
#########################################################################

Question:

I am writing a VBA macro to print an Outlook email to PDF using the Adobe PDF (driver?) printer:

Here is the basic process flow I want to automate:

I will open/select an email that I want to print to PDF
I will ctrl P to print and then select the Adobe PDF as the printer
A "Save PDF File As" dialogue box appears
Within the dialogue, set the save location and set the filename and submit

I have successfully coded steps 1-3. Step 4 is where my problems begin.

I have not found a way to simulate the dialogue box process. I tried AppActivate & SendKeys: the code runs but then it shifts the focus back to the VBE and therefore doesn't do what I need it to within the print dialogue.

I tried finding VBA code that replicates the backend process of the dialogue. I think the dialogue is a function of Adobe so finding VBA to talk to the process is hard.

The only thing I am trying to do with step 4 is to set the save location using a variable then set the filename field using a variable then click save to finish the print process. See screenshot below for dialogue box and relevant fields:

I will post the code I have below. Skip to the code heading titled, "Print/save email as PDF" to get to the good stuff:

Sub saveEmail()

'================================================================================
' Initialize variables
'================================================================================
    Dim olSelection As Outlook.selection
    Dim myItem As Outlook.MailItem
    Dim olAtt As Outlook.Attachment
    Dim olTempFolder As String
    Dim myDate As String: myDate = Year(Now) & Month(Now) & Day(Now) & _
                            Hour(Now) & Minute(Now) & Second(Now)
    Dim myPrinter As String
    
    ' Assign PDF printer to variable
    myPrinter = "Adobe PDF"
    
    ' Assign the window title of the save as pdf dialogue
    myDialogueTitle = "Save PDF File As"
    
    
'================================================================================
' Create email download path
'================================================================================
    ' Get the local temp folder path
    tempPath = ""
    tempPath = VBA.Environ("temp")
    
    ' Add Outlook Attachments subfolder to temp path
    olTempFolder = tempPath & "\Outlook Attachments"
    Debug.Print olTempFolder ' Print the folder path to immediate window
    
    ' If the path exists, check to make sure path is a directory, else create
    dirExists = Dir(olTempFolder, vbDirectory)
    If dirExists <> "" Then
        dirAttr = GetAttr(olTempFolder)
        
        ' Check if path is directory (attribute "16")
        If dirAttr <> 16 Then
            MsgBox "There is an error with the specified path. Check code " & _
                "try again."
        End If
        
    Else
    ' If folder does not exist, create
        MkDir (olTempFolder)
        
    End If
    
'================================================================================
' Create unique folder for this run
'================================================================================
    olTempFolder = olTempFolder & "\emailToPDF-" & myDate
    MkDir (olTempFolder)

'================================================================================
' Print/save email as PDF
'================================================================================
    
    ' Set the default printer
    Set mynetwork = CreateObject("WScript.network")
    mynetwork.setdefaultprinter myPrinter
    
    ' Print the email
    myItem.PrintOut
    
    ' Send keystrokes to Save As dialogue
    AppActivate myDialogueTitle ' Activate the printer dialogue window
    
    SendKeys myDate, True ' Change file name to be saved
    SendKeys "{F4}", True ' Activate path text box
    SendKeys "^a", True ' Select all contents of path text box
    SendKeys "{DEL}", True ' Delete selected contents of text box
    SendKeys olTempFolder, True ' Set desired save path in the path location box
    SendKeys "{ENTER}", True ' Press enter to set the path
    SendKeys "{ENTER}", True ' Press enter to submit/save as

'================================================================================
'
'================================================================================

End Sub

Again, please do not suggest a solution involving the ".SaveAs" method. Our IT administrators have disabled this functionality in Outlook so VBA code calling it does not work.

CodePudding user response：

In order to handle the Print to pdf dialog proceed in the next way:

Copy the next API functions declaration on top of the module (in the declarations area):

 Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
                    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
 Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias _
            "FindWindowExA" (ByVal hwnd1 As LongPtr, _
            ByVal hwnd2 As LongPtr, ByVal lpsz1 As String, _
            ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, _
                                        ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long

There are declarations for 64 bit systems (VBA 7). It can be adjusted to work for both cases.

Use this way to deal with the dialog handlers, to change the pdf file name and press Save:

Sub testFindPdfPrinterWindow()
  Dim pdfHwnd As LongPtr, hwnd1 As LongPtr, hwnd2 As LongPtr, hwnd3 As LongPtr
  Dim hwndCombo As LongPtr, hwndEdit As LongPtr, hwndSave As LongPtr
  pdfHwnd = FindWindow("#32770", "Save PDF File As"): Debug.Print Hex(pdfHwnd)
    hwnd1 = FindWindowEx(pdfHwnd, 0, "DUIViewWndClassName", vbNullString): Debug.Print Hex(hwnd1)
      hwnd2 = FindWindowEx(hwnd1, 0, "DirectUIHWND", vbNullString): Debug.Print Hex(hwnd2)
        hwnd3 = FindWindowEx(hwnd2, 0, "FloatNotifySink", vbNullString): Debug.Print Hex(hwnd3)
          hwndCombo = FindWindowEx(hwnd3, 0, "ComboBox", vbNullString): Debug.Print Hex(hwndCombo)
           hwndEdit = FindWindowEx(hwndCombo, 0, "Edit", vbNullString): Debug.Print Hex(hwndEdit)
           
           Const WM_SETTEXT = &HC
           SendMessage hwndEdit, WM_SETTEXT, 0&, ByVal "MyMail pdf" 'use here what you need as pdf docment to be saved name
           
           hwndSave = FindWindowEx(pdfHwnd, 0, vbNullString, "&Save"): Debug.Print Hex(hwndSave)
           Const WM_LBUTTON_DOWN = &H201, BM_CLICK = &HF5
           SendMessage hwndSave, WM_LBUTTON_DOWN, 0&, 0&
           SendMessage hwndSave, BM_CLICK, 0, ByVal 0&
End Sub

You should play with your code until the moment the dialog is shown and may stop the macro.

Then run the above code.

CodePudding user response：

In the code I didn't find a place where Outlook objects declared at the beginning of the functions are declared.

Dim olSelection As Outlook.selection
Dim myItem As Outlook.MailItem
Dim olAtt As Outlook.Attachment

It seems you need to get the currently selected item in the Explorer window. Use the Selection property of the Explorer class which returns a Selection object that contains the item or items that are selected in the explorer window.

Set myOlExp = Application.ActiveExplorer 
Set myOlSel = myOlExp.Selection 
For x = 1 To myOlSel.Count 
  If myOlSel.Item(x).Class = OlObjectClass.olMail Then

Then you can deal with a selected item. The Word object model can be used for dealing with message bodies. See Chapter 17: Working with Item Bodies for more information. So, you are free to use the Document.SaveAs2 method which saves the specified document with a new name or format. Some of the arguments for this method correspond to the options in the Save As dialog box (File tab).

Also you may find the Document.ExportAsFixedFormat2 method which saves a document as PDF or XPS format.