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

我想消除人为错误，当select一个文件发送附件在电子邮件。 基本上消除这个代码Filename = Application.InputBox("Enter File Name:", "", "File Name")'Type in File Name并将其replace使用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 = "[e-mail]; [e-mail]; [e-mail]" ElseIf List = "silver" Then List = "[e-mail]; [e-mail]" 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 =等于我用下面的代码挑选的文件并正确地附加到电子邮件中？ 任何关于我的编码的build议也会很棒，谢谢！

 Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = False End with 

Answer 1

这里是我的一个类似的子程序的摘录，希望你会发现它有帮助。 将此置于创buildMailItem对象和发送消息之间的某处：

 '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：我认为重新使用上面的代码与用户input分离时更容易，所以我使用单独的函数来创build无论我需要的电子邮件。 只要将所有input作为参数提供，并在准备好时调用.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 

Answer 2

更换

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

有：

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