|
|
Thread Tools | Display Modes |
#2
|
|||
|
|||
Amazing what a good night's sleep and a fresh look at things does, the answer wasn't as complex as I thought it was...
The already written code by Ron de Bruin, which can be found here, was pretty much the final piece of the jigsaw for me. I used Example 1 (attaches the last saved version of the active workbook into an email message) from the site to solve this. I inserted a module into the workbook and pasted the Example 1 code three times - one for each of the departments that the workbook could go to and modified the 'To' and 'Subject' lines to what I needed. The only line of code that I added was line 2 where I 'Called' the 'Public Sub Workbook_BeforeSave' routine from the 'ThisWookbook' Object to give the file the required name when saving it. Code:
Sub emailDept1() Call ThisWorkbook.Workbook_BeforeSave(True, False) Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = "Dept1@xxx.xxx" .CC = "" .BCC = "" .Subject = "text" .Body = "" .Attachments.Add ActiveWorkbook.FullName .Display End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub Sub emailDept2() Call ThisWorkbook.Workbook_BeforeSave(True, False) Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = "Dept2@xxx.xxx" .CC = "" .BCC = "" .Subject = "text" .Body = "" .Attachments.Add ActiveWorkbook.FullName .Display End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub Sub emailDept3() Call ThisWorkbook.Workbook_BeforeSave(True, False) Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = "Dept3@xxx.xxx" .CC = "" .BCC = "" .Subject = "text" .Body = "" .Attachments.Add ActiveWorkbook.FullName .Display End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub The following code for the command buttons was added to the Sheet2 (Ordering template) with the call line executing the corresponding 'attach workbook in an email' subroutine from Module 1. Code:
Private Sub cmdDept1_Click() Call emailDept1 End Sub Private Sub cmdDept2_Click() Call emailDept2 End Sub Private Sub cmdDept3_Click() Call emailDept3 End Sub Mike |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Cannot find file to attach in email | megabyte | Outlook | 0 | 09-23-2020 05:35 AM |
Lost mails (xlsm file attached) (solved) but unbelievelable | agnys | Outlook | 0 | 04-05-2018 05:10 PM |
VBA to create a button to attach the active word doc to an email as a PDF without using Outlook | TAKMalcolm | Word VBA | 1 | 09-21-2017 01:52 AM |
File Not Found error when trying to attach Word document to email | Kimber | Word | 0 | 03-06-2015 06:47 PM |
Having Touble Finding Word File When Trying to Attach to Email | freetibet213 | Word | 3 | 12-28-2011 05:26 AM |