Outlook Application.FileDialog not found

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:

Visual Basic for Applications Microsoft Outlook 15.0 Object Library

Microsoft Office 15.0 Object Library OLE Automation Microsoft Forms

Microsoft Office 15.0 Object Library

OLE Automation Microsoft Forms Object Library

Microsoft Scripting Run-time

Microsoft Office 15.0 Access database engine Object Library

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

---

这是我用过的另一种解决方法

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

链接地址: http://www.djcxy.com/p/63770.html

上一篇: mysql中每行最高x的总和

下一篇: 未找到Outlook Application.FileDialog