Outlook Application.FileDialog not found

Outlook doesn't support the FileDialog object. Here's a workaround:

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False

Dim fd As Office.FileDialog
Set fd = xlApp.Application.FileDialog(msoFileDialogFilePicker)

Dim selectedItem As Variant

If fd.Show = -1 Then
    For Each selectedItem In fd.SelectedItems
        Debug.Print selectedItem
    Next
End If

Set fd = Nothing
    xlApp.Quit
Set xlApp = Nothing

Here is another workaround that I have used

Option Explicit
' For Outlook 2010.
#If VBA7 Then
    ' The window handle of Outlook.
    Private lHwnd As LongPtr

    ' /* API declarations. */
    Private Declare PtrSafe Function FindWindow Lib "user32" _
            Alias "FindWindowA" (ByVal lpClassName As String, _
                                 ByVal lpWindowName As String) As LongPtr

' For the previous version of Outlook 2010.
#Else
    ' The window handle of Outlook.
    Private lHwnd As Long

    ' /* API declarations. */
    Private Declare Function FindWindow Lib "user32" _
            Alias "FindWindowA" (ByVal lpClassName As String, _
                                 ByVal lpWindowName As String) As Long
#End If
'
' Windows desktop -
' the virtual folder that is the root of the namespace.
Private Const CSIDL_DESKTOP = &H0

' Only return file system directories.
' If user selects folders that are not part of the file system,
' then OK button is grayed.
Private Const BIF_RETURNONLYFSDIRS = &H1

' Do not include network folders below
' the domain level in the dialog box's tree view control.
Private Const BIF_DONTGOBELOWDOMAIN = &H2

Public Sub SelectFolder()
    Dim objFSO As Object
    Dim objShell As Object
    Dim objFolder As Object
    Dim strFolderPath As String
    Dim blnIsEnd As Boolean

    blnIsEnd = False

    Set objShell = CreateObject("Shell.Application")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objShell.BrowseForFolder( _
                lHwnd, "Please Select Folder to:", _
                BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN, CSIDL_DESKTOP)


    If objFolder Is Nothing Then
        strFolderPath = ""
        blnIsEnd = True
        GoTo PROC_EXIT
    Else
        strFolderPath = CGPath(objFolder.Self.Path)
    End If

PROC_EXIT:
    Set objFSO = Nothing
    If blnIsEnd Then End
End Sub

Public Function CGPath(ByVal Path As String) As String
    If Right(Path, 1) <> "\" Then Path = Path & "\"
    CGPath = Path
End Function

Tags:

Vba

Outlook