Automate emailing current workbook to end users

[Robert_Conklin]

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]

.
Paste the following in a Routine Module :

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]

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:

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]

.
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]

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!!

 

[Logit]

.
You are welcome.

Cheers !

 

[Robert_Conklin]

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]

.
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 :

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]

Ok, below is my 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.

 

[Robert_Conklin]

Any direction would be greatly appreciated. Thanks in advance.