未找到Outlook Application.FileDialog
我正在为Outlook编写VBA宏,并且Application.FileDialog方法不可用。
目的是让用户选择一个文件夹 - 不是Outlook电子邮件文件夹,而是文件系统目录文件夹。
以下是我启用的参考资料:
有任何想法吗?
Outlook不支持FileDialog对象。 这是一个解决方法:
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/63769.html