Implementing a File Picker dialog box in Outlook VBA - vba

Question

So you're creating an Outlook macro that prompts the users to select file(s) - but you can't quite get it right. Hopefully this will help.
There seems to be a number of related questions, but I'm consolidating everything here and showing what worked for me in the end.
Outlook Application.FileDialog not found
Where is Outlook's save FileDialog?
How to implement Application.FileDialog using Outlook VBA?
FilePicker in Macro opens dialogbox in background
The most annoying thing for me was the fact that once you've implemented a workaround, the File Dialog will open in the background whenever you're not running the code from VBE directly.

Answer 1

Right out of the gate, the Outlook Application doesn't support VBA FileDialog object. Theoretically Outlook itself supports this since you can do File > Save As and File > Open & Export...but you can't simply call the object from VBA.
For my project - I have a sub that replaces tokens with user input, but I wanted to give folks the option of picking which Template to open. I'd recommend reading up on the FileDialog object itself as there are several helpful examples in the Microsoft documentation.
There are a number of options, but below are the 2 main workarounds I've found. I prefer the first method as it doesn't require adding a reference - meaning that the macro(s) can be more easily shared without compilation errors.
Method 1: No References Needed (hopefully)
#If VBA7 Then
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal win As LongPtr) As LongPtr
#Else
Private Declare Function SetForegroundWindow Lib "user32" (ByVal win As Long) As Long
#End If
Option Explicit
Sub CreateEmailUsingSelectedTemplate()
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
'MsgBox "The top-level window handle is: " & xlApp.hWnd
Dim fd As Office.FileDialog
Set fd = xlApp.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
SetForegroundWindow (xlApp.hWnd)
With fd
.InitialFileName = Environ("APPDATA") & "\Microsoft\Templates\"
.Filters.Add "All Files", "*.*", 1
.Filters.Add "Templates", "*.oft", 2
.FilterIndex = 2
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
MsgBox "Selected item's path: " & vrtSelectedItem
'FindAndReplaceTokens CStr(vrtSelectedItem)
Next vrtSelectedItem
Else 'If the user presses Cancel...
MsgBox "Hit cancel instead of Accept"
Exit Sub
End If
End With
End Sub
Method 2: Early Binding
See FilePicker in Macro opens dialogbox in background and File dialog box not displaying on top and not visable
'Set reference to 'Microsoft Excel XX Object Library' in
'Tools > References
#If VBA7 Then
Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal class As String, ByVal caption As String) As LongPtr
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal win As LongPtr) As LongPtr
#Else
Private Declare Function FindWindowA Lib "user32" (ByVal class As String, ByVal caption As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal win As Long) As Long
#End If
Option Explicit
Sub ShowDialogBox()
Dim fd As Office.FileDialog
Dim xlApp As Excel.Application
Dim hxl As LongPtr
Dim vrtSelectedItem As Variant
Set xlApp = New Excel.Application
Set fd = xlApp.FileDialog(msoFileDialogFilePicker)
hxl = FindWindowA("XLMAIN", "EXCEL")
If Not IsNull(hxl) Then
SetForegroundWindow (hxl)
End If
If fd.Show = -1 Then
For Each vrtSelectedItem In fd.SelectedItems
MsgBox "Selected item's path: " & vrtSelectedItem
'Put your code here
Next vrtSelectedItem
Else
MsgBox "User hit cancel"
Exit Sub
'Do something different here
End If
End Sub