Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-01-2022, 07:48 PM
kiwimtnbkr kiwimtnbkr is offline Attach .xlsm file to Outlook email from whatever folder it's been saved in Windows 10 Attach .xlsm file to Outlook email from whatever folder it's been saved in Office 2019
Advanced Beginner
Attach .xlsm file to Outlook email from whatever folder it's been saved in
 
Join Date: Oct 2017
Posts: 69
kiwimtnbkr is on a distinguished road
Default Attach .xlsm file to Outlook email from whatever folder it's been saved in

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

Last edited by kiwimtnbkr; 04-01-2022 at 07:49 PM. Reason: clarity
Reply With Quote
  #2  
Old 04-02-2022, 11:32 PM
kiwimtnbkr kiwimtnbkr is offline Attach .xlsm file to Outlook email from whatever folder it's been saved in Windows 10 Attach .xlsm file to Outlook email from whatever folder it's been saved in Office 2019
Advanced Beginner
Attach .xlsm file to Outlook email from whatever folder it's been saved in
 
Join Date: Oct 2017
Posts: 69
kiwimtnbkr is on a distinguished road
Default

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
Reply With Quote
Reply

Thread Tools
Display Modes


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
Attach .xlsm file to Outlook email from whatever folder it's been saved in Having Touble Finding Word File When Trying to Attach to Email freetibet213 Word 3 12-28-2011 05:26 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 02:10 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft