Automate emailing current workbook to end users

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
173
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
I currently have a workbook that employs userforms that my end users fill out to send in part maintenance requests. Once we receive the workbooks from the end users I process their requests into out SAP system. Once I process the data, I have to click the email icon in my quick reference bar to email the open workbook back to the end user.

Is it possible to use VBA to trigger an automatic email sent back to the end user with the open workbook as an attachment?
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
.
Paste the following in a Routine Module :

Code:
Option Explicit


Sub Mail_workbook_Outlook()


    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 = "me@yahoo.com"                '<-- you can add email addresses separated by comma
        .CC = ""
        .BCC = ""
        .Subject = "Test"
        .Body = ""
        .Attachments.Add (Application.ActiveWorkbook.FullName)
        
        '.Send                              '<-- .Send will auto send email without review
        .Display                            '<-- .Display will show the email first for review
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Upvote 0
Thanks for the code Logit, I placed the code (and additions) to transfer module so it would be activated when I clicked my transfer command button. When I do so, the new email is not generated. Below is the code I am working with:

Code:
Sub DataTrAll()Application.ScreenUpdating = False
   fpath = "Z:\Engineering\Spar2\WinShuttle Daily Loads"
    'fpath = "C:\Users\Grote\Downloads\8. Robert"
    fname = "SPAR LOAD PROCESS WORKSHEET 2018.xlsx"
   Set dWB = Workbooks.Open(fpath & "\" & fname)
Call DataTrAEtoAE
Call DDataTrAE
Call DDataTrBS
Call DataTrAEtoBS
Call DDataTrEX
Call DataTrAEtoEX
Call DataTrAUtoAU
Call DataTrAUtoAUL
Call DataTrBLtoBL
Call DataTrBLtoBLL
Call DataTrDCtoDC
Call DataTrIOtoIO
Call DataTrMMtoMM
Call DataTrMMtoMML
Call DataTrMTtoMT
Call DataTrMTtoMTL
Call DataTrNDtoND
Call DDataTr4E
Call DataTrAEto4E
Call DataTrDRtoDR
dWB.Sheets("BASIC").Activate
Application.ScreenUpdating = True
End Sub
Sub DataTrAll_REP()
Application.ScreenUpdating = False
   fpath = "R:\REPOSITORY"
    'fpath = "C:\Users\Grote\Downloads\8. Robert"
    fname = "MASTER PARTS REPOSITORY 2018.xlsx"
   Set dWB = Workbooks.Open(fpath & "\" & fname)
Call DataTrAEtoAE_REP
Call DataTrAUtoAU_REP
Call DataTrBLtoBL_REP
Call DataTrDCtoDC_REP
Call DataTrIOtoIO_REP
Call DataTrMMtoMM_REP
Call DataTrMTtoMT_REP
Call DataTrNDtoND_REP
dWB.Sheets("ADD-EXTEND").Activate
Application.ScreenUpdating = True
End Sub
Sub Mail_workbook_Outlook()




    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 = ""                '<-- you can add email addresses separated by comma
        .CC = "SPAR@flocorp.com"
        .BCC = ""
        .Subject = "Spare Parts Maintenance"
        .Body = "The parts have been placed on today's load sheet and will be processed by EOB today.  Please remember to trasnfer your data to your repository file."
        .Attachments.Add (Application.ActiveWorkbook.FullName)
        
        '.Send                              '<-- .Send will auto send email without review
        .Display                            '<-- .Display will show the email first for review
    End With
    On Error GoTo 0




    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Upvote 0
.
You have a number of macros that are being 'called', so I'm not absolutely certain which one is 'called' last. Which ever macro runs last, at the bottom of the macro ... just above "End Sub"
paste this line : Call Mail_workbook_Outlook

That will auto run the email macro as the last thing in your workbook.

As an alternative, you can just add a Command Button to your worksheet (any sheet you desire) and assign it to the "Sub Mail_workbook_Outlook" macro. That will require you to click the button
when you want to send an email.
 
Upvote 0
I created an individual module for the email, and used the call event in the transfer code. That worked like a charm. Thanks again Logit!!
 
Upvote 0
As an addition to the request above, is it possible to have the code search certain fields and automatically search a table for the entries in those fields and place the email addresses for those entries in the To: field of the email?
 
Upvote 0
.
This is one way to accomplish the goal. In A1, you will enter each address separated by a comma, just as you would in other email programs :

Code:
Option Explicit


Sub Mail_workbook_Outlook()




    Dim OutApp As Object
    Dim OutMail As Object
    Dim SendTo As String




    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    SendTo = Sheets("Sheet1").Range("A1").Value
    On Error Resume Next
    
    With OutMail
        .to = SendTo       '<-- you can add email addresses separated by comma
        .CC = ""
        .BCC = ""
        .Subject = "Test"
        .Body = ""
        .Attachments.Add (Application.ActiveWorkbook.FullName)
        
        '.Send                              '<-- .Send will auto send email without review
        .Display                            '<-- .Display will show the email first for review
    End With
    On Error GoTo 0




    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Upvote 0
Ok, below is my code:

Code:
Option Explicit

Sub Mail_workbook_Outlook()




    Dim OutApp As Object
    Dim OutMail As Object
    Dim SendTo As String


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    SendTo = Sheets("LISTS").Range("N2").Value
    On Error Resume Next


    With OutMail
        .to = ""                '<-- you can add email addresses separated by comma
        .CC = "SPAR@flocorp.com"
        .BCC = ""
        .Subject = "Spare Parts Maintenance"
        .Body = "The parts have been placed on today's load sheet and will be processed by EOB today.  This data has also been placed on the repository file."
        .Attachments.Add (Application.ActiveWorkbook.FullName)
        
        '.Send                              '<-- .Send will auto send email without review
        .Display                            '<-- .Display will show the email first for review
    End With
    On Error GoTo 0




    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

I get a Runtime error 9 - Subscript out of range at "SendTo - Sheets ("LISTS").Range("N2").value" Column N on the LISTS sheet houses all of the email addresses and has a dataname of "email". What I need to happen is the code look into field T_02 on the userform to determine the plant number and match that plant number to column "L" which has a dataname of "plantnum". For each match it finds, the corresponding email address from column "N" should be placed in the To: section of the opened email.

I hope I explained that correctly.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,205
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top