Question

我想在选择要在电子邮件中附件中发送的文件时消除人为错误。基本上消除了这段代码Filename = Application.InputBox("Enter File Name:", "", "File Name")'Type in File Name并使用FileDialog替换它，这已经引起我的注意，是实现这一目标的好方法。我对如何正确使用它感到很困惑。每次我尝试过，我都可以使用该应用程序并查看该文件，但我不明白它是如何附加的。我的电子邮件编码如下。

Sub Mail_workbook_Test()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Date1 As Date
    Dim Recipient As Variant


Date1 = Format(Now, "yyyy-mm-dd")
'Date and format
UserName = Application.InputBox("Enter your name:", "", "FirstLast")
Filename = Application.InputBox("Enter File Name:", "", "File Name")
'Type in File Name

List = Application.InputBox("Enter Email List Name:", "", "ListName")
'Type in Email List
If List = "gold" Then
List = "example@mail.com; example1@mail.com; example2@mail.com"
ElseIf List = "silver" Then
List = "example@mail.com; example@mail.com"
Else
MsgBox ("Sorry, your list selection was not recognised.")
Exit Sub
End If


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


With OutMail
For Each Recipient In Split(List, ";")
    .Recipients.Add Trim(Recipient)
Next
    .CC = ""
    .BCC = ""
    .Subject = "" + Filename + "" & " " & Date1
    .Body = "Hi Everyone," & Chr(10) & Chr(10) & "Please let me know if you get this!" & Chr(10) & Chr(10) & "Thanks!"""
    .Attachments.Add ("C:\Users\" + UserName + "\Desktop\" + Filename + ".xlsx")
    .Send   '.Display
End With


Set OutMail = Nothing
Set OutApp = Nothing

End Sub

如何让Filename =与我选择的文件相同，并使用下面的代码正确附加到电子邮件中？对我的编码有任何建议也很好，谢谢！

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd


        .AllowMultiSelect = False
End with

Answer 1

替换

Filename = Application.InputBox("Enter File Name:", "", "File Name")

with：

With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Show
Filename = .SelectedItems(1)
End With

Answer 2

这是我的类似子程序的摘录，希望你会发现它有用。将它放在创建MailItem对象和发送消息之间的某处：

'Ask which files to open (using FileDialog)
Dim fdInputFile As FileDialog
Set fdInputFile = Application.FileDialog(msoFileDialogOpen)
With fdInputFile
    .Filters.Clear
    .AllowMultiSelect = True
    If .Show = False Then Exit Function 'you might want to handle "Cancel" button differently
End With

'Attach all files
Dim sInputFile As Variant
For Each sInputFile In fdInputFile.SelectedItems
    OutMail.Attachments.Add sInputFile, 1
Next sInputFile

PS：我认为当它与用户输入分开时重用上面的代码会更容易，所以我使用一个单独的函数来创建我需要的电子邮件。只需将所有输入作为参数提供，并在准备好时调用.Send方法

Public Function CreateEmailMsg(cRecipients, _
                        Optional sSubject As String = "", _
                        Optional sBody As String = "", _
                        Optional cAttachments = Nothing) _
                        As Object
'
' Generate new e-mail message
'
' Parameters:
'   cRecipients: String (or a Collection of Strings) containing
'                e-mail addresses of recipients
'   sSubject: String containing message subject line
'   sBody: String containing message body (HTML or plain text)
'   cAttachments: String (or a Collection of Strings) containing
'                 path(s) to attachments
'
' Returns MailItem object referring to the created message
' Most common methods for MailItem object are .Display and .Send
'
    Dim appOL As Object
    Set appOL = CreateObject("Outlook.Application")

    Dim msgNew As Object
    Set msgNew = appOL.CreateItem(0) 'olMailItem

    Dim sItem
    With msgNew
        'Message body
        .BodyFormat = 2 'olFormatHTML
        .HTMLBody = sBody

        'Recipients
        If TypeName(cRecipients) = "String" Then
            .Recipients.Add cRecipients
        ElseIf Not cRecipients Is Nothing Then
            For Each sItem In cRecipients
                .Recipients.Add sItem
            Next sItem
        End If

        'Subject
        .Subject = sSubject

        'Attachments
        If TypeName(cAttachments) = "String" Then
            .Attachments.Add cAttachments, 1
        ElseIf Not cAttachments Is Nothing Then
            For Each sItem In cAttachments
                .Attachments.Add sItem, 1
            Next sItem
        End If
     End With

    Set CreateEmailMsg = msgNew
End Function

使用FileDialog将文件附加到电子邮件

2 个答案: