How to Print to PDF, not Save?" - vba

Question

App Versions:
Outlook: Microsoft 365 Apps for enterprise
Adobe Acrobat Pro DC: version 2022.001.20117
DISCLAIMER:
My company has disabled "save as" functionality in Outlook.
Please do not suggest any VBA methods that involve ".SaveAs".
Question:
I want to print an Outlook email to PDF using the Adobe PDF (driver?) printer:
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 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 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.
I am trying with step 4 to set the save location using a variable then set the filename field using a variable then click save to finish the print process.
Dialogue box and relevant fields:
Note: I save attachments using .SaveAsFile as MailItem.SaveAs does not work.
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)
'================================================================================
' Save attachments from selected email
'================================================================================
Set olSelection = ActiveExplorer.selection
Set myItem = olSelection.Item(1)
For Each olAtt In myItem.Attachments
attFullPath = olTempFolder & "\" & olAtt.DisplayName
olAtt.SaveAsFile (attFullPath)
Next
'===============================================================================
' Print/save email as
'================================================================================
' 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 disabled this functionality in Outlook so VBA code calling it does not work.

Answer 1

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.

Answer 2

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 handlePrintToPDF()
Dim pdfHwnd As LongPtr, hwnd1 As LongPtr, hwnd2 As LongPtr, hwnd3 As LongPtr
Dim hwndCombo As LongPtr, hwndEdit As LongPtr, hwndSave As LongPtr
Dim tempPath, olTempFolder As String, myDate As String
tempPath = VBA.Environ("temp")
olTempFolder = tempPath & "\Outlook Attachments"
myDate = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & ".pdf"
Do While pdfHwnd = 0
DoEvents
pdfHwnd = FindWindow("#32770", "Save PDF File As"): Debug.Print Hex(pdfHwnd)
Loop
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
Dim pdfFileFullName: pdfFileFullName = olTempFolder & "\" & myDate
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
Call the above sub after myItem.PrintOut:
handlePrintToPDF
But launching the print window (from Outlook) will block VBA. I used it as an automation from Excel...