Question

我想在Outlook中将文件附加到我的邮件中。它永远不会是同一条路径，因此我想在文件管理器中选择该路径。

我尝试使用Application.FileDialog，但是每次遇到运行时错误438。我在互联网上找到了以下代码：

Sub Main()
 Dim fd As FileDialog
 Set fd = Application.FileDialog(msoFileDialogFilePicker)

 Dim vrtSelectedItem As Variant

 With fd

 If .Show = -1 Then

 For Each vrtSelectedItem In .SelectedItems


 Next vrtSelectedItem
 Else
 End If
 End With

 Set fd = Nothing
End Sub

Answer 1

您如何使用Windows API调用

Option Explicit
Public Declare Function GetOpenFileNameB Lib "comdlg32.dll" _
                                Alias "GetOpenFileNameA" _
                (pOpenfilename As OPENFILENAME) As Long

Public Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type


Public Sub Example()
    Dim Email As Outlook.MailItem
    Set Email = Application.CreateItem(0)

    Dim File As String
        File = GetOpenFileName()

    With Email
        .To = ""
        .Attachments.Add (File)
        .Display
    End With

End Sub


Public Function GetOpenFileName(Optional ByVal vFileFilter As String, _
                                Optional ByVal vWindowTitle As String, _
                                Optional ByVal vInitialDir As String, _
                                Optional ByVal vInitialFileName As String) As String

Dim OFN As OPENFILENAME, retVal As Long
    OFN.lStructSize = Len(OFN)
    OFN.hwndOwner = 0
    OFN.hInstance = 0
    OFN.lpstrFile = IIf(vInitialDir = "", Space$(254), vInitialDir & Space$(254 - Len(vInitialDir)))
    OFN.lpstrInitialDir = IIf(vWindowTitle = "", CurDir, vInitialDir)
    OFN.lpstrTitle = IIf(vWindowTitle = "", "Select File", vWindowTitle)
    OFN.lpstrFilter = IIf(vFileFilter = "", "All Files (*.*)" & Chr(0) & "*.*", _
                                Replace(vFileFilter, ",", Chr$(0)))

    OFN.nMaxFile = 255
    OFN.lpstrFileTitle = Space$(254)
    OFN.nMaxFileTitle = 255
    OFN.flags = 0

    retVal = GetOpenFileNameB(OFN)

    If retVal Then GetOpenFileName = Trim$(OFN.lpstrFile)
End Function

运行Public Sub Example()

Answer 2

我找到了以下解决方案。它可以工作，但是FileDialog在Backgorund中启动。是否有意见要在用户窗体和Outlook窗口的前面启动文件窗口

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

如何在Outlook VBA上打开文件对话框

2 个答案: