Automate emailing current workbook to end users

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
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?
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,920
.
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
 

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
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
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,920
.
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.
 

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
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!!
 

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
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?
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,920
.
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
 

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
120
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.
 

Forum statistics

Threads
1,081,705
Messages
5,360,759
Members
400,595
Latest member
T_Dubs

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top