Attach .xlsm file to Outlook email from whatever folder it's been saved in

kiwimtnbkr · #1 04-01-2022, 07:48 PM

This may be a case that I can't see the forest for the trees and the answer is not as complex as I think it is.

The code below runs to provide the file name as part of the SaveAs routine. The .xltm is saved as an .xlsm file in various folders by the users, depending on what it is that they are requesting.

Code:

Public Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Set ws = ActiveSheet
Dim xFileName As String
Dim U7part As String, U8part As String, K13part As String

Dim strMsg As String
    If (Range("U7") = Empty) Then
        MsgBox "'Request number' is mandatory.", vbCritical, "Title"
        Cancel = True
        Range("U7").Select
    Exit Sub
        Else
    If (Range("U8") = Empty) Then
        MsgBox "'Request date' is mandatory.", vbCritical, "Title"
        Cancel = True
        Range("U8").Select
    Exit Sub
        Else
    If (Range("L33") = "click here then select from drop down list") Then
        MsgBox "para. 3.b. 'Method of Delivery' is mandatory.", vbExclamation, "Title"
        Cancel = True
        Range("L33").Select
    Exit Sub
        Else
    If (Range("L37") = Empty) Then
        MsgBox "para. 3.d. 'Date required by' is missing.", vbExclamation, "Title"
        Cancel = True
        Range("L37").Select
    Exit Sub
        Else
Call RenameTemplateSheet
        U7part = ws.Range("U7").value
        U7part = Replace(Replace(U7part, " / ", "/"), "/", "_")
        U8part = ws.Range("U8").value
        U8part = Replace(Replace(U8part, " / ", "/"), "/", "_")
        K13part = ws.Range("K13").value
        K13part = Replace(K13part, "/", "_")
Range("U9").Select
If SaveAsUI <> False Then
    Cancel = True
        xFileName = Application.GetSaveAsFilename(K13part & " Text " & Range("A1").value & U7part & " dated " & U8part, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm", , "Save As xlsm file")
            If xFileName <> "False" Then
            Application.EnableEvents = False
            ActiveWorkbook.SaveAs Filename:=xFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.EnableEvents = True
        End If
    End If
    End If
    End If
    End If
End If
End Sub

How do I get the saved .xlsm file, from whichever folder it has been saved into, to then become an attachment in an Outlook email?

The code will be attached to 'Save and Email to Department x' command buttons so that when the user clicks one of the three command buttons, the 'To address' will be pre-populated with the correct 'To address'.

I thought I was finally onto something with the code I found here but I can't make it work no matter what I try.

cheers
Mike

kiwimtnbkr · #2 04-02-2022, 11:32 PM

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

Three ActiveX command buttons were added to the template sheet, in my case 'Sheet2 (Ordering template), and named 'Private Sub cmdDept1_Click()', 'Private Sub cmdDept2_Click() and ''Private Sub cmdDept3_Click()' respectively.

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

cheers
Mike

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

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