I'm writing a VBA macro for Outlook and the Application.FileDialog method is not available.
The intent is for the user to select a folder - not an Outlook email folder, but a file system directory folder.
Here are the references I have enabled:
Any ideas?
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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With