Using FileDialog to attach a file to an email - excel

Question

I want to eliminate human error when it comes to selecting a file to send in an attachment in an email. Basically eliminating this code Filename = Application.InputBox("Enter File Name:", "", "File Name")'Type in File Name And replace it using FileDialog which has come to my attention as a good way of accomplishing this. I am very confused on how to use it correctly. Every time I have tried, I am able to use the application and see the file but I don't understand how it gets attached. My email coding is below.
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
How do I get Filename = to equal the file I pick with the code below and properly attach into an email? Any advice on my coding would be great too, thank you!
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
End with

Answer 1

Replace
Filename = Application.InputBox("Enter File Name:", "", "File Name")
with:
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
Filename = .SelectedItems(1)
End With

Answer 2

Here is an excerpt from a similar subroutine of mine, hope you'll find it helpful. Place this somewhere between creating MailItem object and sending the message:
'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: I think it's easier to reuse the code above when it's separated from user input, so I use a separate function for creating e-mails whereever I need to. Just feed all the input as the parameters and call .Send method when you're ready
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