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
'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