Hello cheddarthief,
Here is the revised macro. It uses cell "A1" as the TO address. You can change this to whichever cell you will be using.
Sub MailSheet()
Dim FileName As String
Dim olApp As Object
Dim shtName As String
shtName = ActiveSheet.Name
FileName = Application.GetSaveAsFilename("Request for Quote " & shtName, "Microsoft Excel File, *.xls")
If FileName = "False" Then Exit Sub
ActiveSheet.Copy
ActiveWorkbook.SaveAs FileName
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.To = Range("A1")
.Subject = "Request for Quote"
.Body = ""
.Attachments.Add FileName, 1
.Display
End With
Cleanup:
ActiveWorkbook.Close False
Kill FileName
End Sub
Bookmarks