0

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.

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.

immobile2
  • 489
  • 2
  • 15

1 Answers1

0

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
immobile2
  • 489
  • 2
  • 15