VBA to include modules in emailed workbook

rarchibald

New Member
Joined
May 26, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hi there,

I am using the code below to email out a report (using task scheduler & macro launcher to email our daily). The report I'm emailing out contains macro buttons, relating to two modules (Module1 and Module2). The code below works as far as sending the workbook as an attachment, but the modules are not included in the workbook that's sent. I've been looking at this post to try and integrate it in the code below - VBA to Copy a Module to Another Workbook - but am struggling. Any ideas? I need to copy the two modules to the temporary file that is saved and sent.

Thanks in advance for any advice!
-Rob

VBA Code:
Option Explicit

Sub EmailandSaveCellValue()
     
     'Variable declaration
    Dim oApp As Object, _
    oMail As Object, _
    WB As Workbook, _
    FileName As String, MailSub As String, MailTxt As String
    Dim MailTo As String
    Dim MailCC As String
    '*********************************************************
    'Set email details; Comment out if not required
    MailTo = Range("Emails")
    MailCC = Range("ccEmails")
    'Const MailBCC = "some3@someone.com"
    MailSub = "Daily Firmwide Utilization Report"
    MailTxt = "Attached is the daily utilization report for " & Range("DailyDate") & ". You can drill down on practice groups, professionals and matters. This report is default to show you the previous business days' time entries. If you select the tab on the bottom you can modify the time period to your desires."
    '*********************************************************
     
     'Turns off screen updating
    Application.ScreenUpdating = False
     
     'Makes a copy of the active workbook and save it to
     'a temporary file
    ActiveWorkbook.RefreshAll
    ActiveWorkbook.Save
    ActiveWorkbook.Sheets.Copy
    Set WB = ActiveWorkbook
    FileName = "Firmwide Utilization " & Range("DailyDate")
    On Error Resume Next
    Kill "C:\" & FileName
    On Error GoTo 0
    WB.SaveAs FileName:="C:\Users\rarchibald\Desktop\" & FileName & ".xlsm", FileFormat:=52
     
     'Creates and shows the outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    With oMail
        .To = MailTo
        .Cc = MailCC
        .Bcc = ""
        .Subject = MailSub
        .Body = MailTxt
        .Attachments.Add WB.FullName
        .Send
    End With
     
     'Deletes the temporary file
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False
     
     'Restores screen updating and release Outlook
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

severynm

Board Regular
Joined
Jan 8, 2021
Messages
193
Office Version
  1. 365
Platform
  1. Windows
Welcome!

1. Is there any reason the code must be in a separate module or can it be moved into a worksheet? That might solve your issue without too much extra effort.

2. Otherwise, you can use the VBA Extensibility library to directly access the editor object to add/modify whatever modules as necessary. The solution was hacked together from two solutions at StackOverflow: Inserting a module into a new workbook using VBA and VBA to copy Module from one Excel Workbook to another Workbook. StackOverflow is definitely your friend :)

From the second post:
Just make sure, following things are done before running this macro.
  • VB Editor > Tools > References > (Check) Microsoft Visual Basic for Applications Extensibility 5.3
  • File -> Options -> Trust Center -> Trust Center Setttings -> Macro Settings -> Trust Access to the VBA Project object model.

Basically, I have two functions, one that does the work, and one that calls the other function and provides the required parameters: the target workbook to add the module into, and the name of the new module. Change those strings as required for you

VBA Code:
Private Sub main()
    AddModuleToTargetWorkbook Workbooks("DestinationWorkbookName", "NewModuleName")
End Sub



Private Sub AddModuleToTargetWorkbook(targetWorkbook As Workbook, newModuleName As String)
    Dim sourceProject As VBIDE.VBProject
    Dim targetProject As VBIDE.VBProject
    Set sourceProject = ThisWorkbook.VBProject
    Set targetProject = targetWorkbook.VBProject
   
    Dim sourceModule As VBIDE.CodeModule
    Dim targetModule As VBIDE.VBComponent
    Set sourceModule = sourceProject.VBComponents("Module1").CodeModule 'Change to the relevant source module name with the code you want to duplicate
    Set targetModule = targetProject.VBComponents.Add(vbext_ct_StdModule)

    targetModule.CodeModule.DeleteLines 1, targetModule.CodeModule.CountOfLines 'leftover from my own code, but also removes Option Explicit to prevent it duplicating in the new module
    targetModule.CodeModule.AddFromString sourceModule.Lines(1, .CountOfLines)
    targetModule.Name = newModuleName
End Sub
 

rarchibald

New Member
Joined
May 26, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Welcome!

1. Is there any reason the code must be in a separate module or can it be moved into a worksheet? That might solve your issue without too much extra effort.

2. Otherwise, you can use the VBA Extensibility library to directly access the editor object to add/modify whatever modules as necessary. The solution was hacked together from two solutions at StackOverflow: Inserting a module into a new workbook using VBA and VBA to copy Module from one Excel Workbook to another Workbook. StackOverflow is definitely your friend :)

From the second post:


Basically, I have two functions, one that does the work, and one that calls the other function and provides the required parameters: the target workbook to add the module into, and the name of the new module. Change those strings as required for you

VBA Code:
Private Sub main()
    AddModuleToTargetWorkbook Workbooks("DestinationWorkbookName", "NewModuleName")
End Sub



Private Sub AddModuleToTargetWorkbook(targetWorkbook As Workbook, newModuleName As String)
    Dim sourceProject As VBIDE.VBProject
    Dim targetProject As VBIDE.VBProject
    Set sourceProject = ThisWorkbook.VBProject
    Set targetProject = targetWorkbook.VBProject
  
    Dim sourceModule As VBIDE.CodeModule
    Dim targetModule As VBIDE.VBComponent
    Set sourceModule = sourceProject.VBComponents("Module1").CodeModule 'Change to the relevant source module name with the code you want to duplicate
    Set targetModule = targetProject.VBComponents.Add(vbext_ct_StdModule)

    targetModule.CodeModule.DeleteLines 1, targetModule.CodeModule.CountOfLines 'leftover from my own code, but also removes Option Explicit to prevent it duplicating in the new module
    targetModule.CodeModule.AddFromString sourceModule.Lines(1, .CountOfLines)
    targetModule.Name = newModuleName
End Sub
 

rarchibald

New Member
Joined
May 26, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Thank you!!
There was no reason for the code to be in a module, I've added it to the sheets and it now carries across in the copied version. But, I'm still having the issue of the macro buttons on the report still pointing to the original file location. I recorded a macro to re-assign these to the active workbook sheets, which works when run from the new version (if the original is on a drive the recipient can access), but ideally I want this all to be taken care of before it is sent, so the recipient receives a working book.
I've added the code to reassign macros to buttons into my main script (see below). This works up until where it tries to attach it to the email ( .Attachments.Add wb.FullName ), it says there is an automation error with this, but I can't work out why. Any ideas?

VBA Code:
Option Explicit

Sub EmailandSaveCellValue()
     
     'Variable declaration
    Dim oApp As Object, _
    oMail As Object, _
    wb As Workbook, _
    FileName As String, MailSub As String, MailTxt As String
    Dim MailTo As String
    Dim MailCC As String

    '*********************************************************
    'Set email details; Comment out if not required
    MailTo = Range("Emails")
    MailCC = Range("ccEmails")
    'Const MailBCC = "some3@someone.com"
    MailSub = "Daily Firmwide Utilization Report"
    MailTxt = "Attached is the daily utilization report for " & Range("DailyDate") & ". You can drill down on practice groups, professionals and matters. This report is default to show you the previous business days' time entries. If you select the tab on the bottom you can modify the time period to your desires."
    '*********************************************************
     
     'Turns off screen updating
    Application.ScreenUpdating = False
     
     'Makes a copy of the active workbook and save it to
     'a temporary file
    ActiveWorkbook.RefreshAll
    ActiveWorkbook.Save
    ActiveWorkbook.Sheets.Copy
    Set wb = ActiveWorkbook
    FileName = "Firmwide Employee Utilization"
    On Error Resume Next
    Kill "C:\" & FileName
    On Error GoTo 0
    wb.SaveAs FileName:="C:\Users\rarchibald\Desktop\" & FileName & ".xlsm", FileFormat:=52

    Dim wbo As Workbook
    Dim myfilename As String

    myfilename = "C:\Users\rarchibald\Desktop\Firmwide Employee Utilization.xlsm"
    '~~> open the workbook and pass it to workbook object variable
    Set wbo = Workbooks.Open(myfilename)
    Sheets("Previous Business Day").Select
    ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select
    Selection.OnAction = "Sheet2.ExpDep"
    ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
    Selection.OnAction = "Sheet2.ColDep"
    ActiveSheet.Shapes.Range(Array("Rectangle 3")).Select
    Selection.OnAction = "Sheet2.ExpPro"
    ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select
    Selection.OnAction = "Sheet2.ColPro"
    ActiveSheet.Shapes.Range(Array("Rectangle 5")).Select
    Selection.OnAction = "Sheet2.ExpMat"
    ActiveSheet.Shapes.Range(Array("Rectangle 6")).Select
    Selection.OnAction = "Sheet2.ColMat"
    ActiveSheet.Shapes.Range(Array("Rectangle 7")).Select
    Selection.OnAction = "Sheet2.RefreshData"
    Sheets("Dynamic Dates").Select
    ActiveSheet.Shapes.Range(Array("Rectangle 3")).Select
    Selection.OnAction = "Sheet1.ExpandDept"
    ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select
    Selection.OnAction = "Sheet1.ColapseDept"
    ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select
    Selection.OnAction = "Sheet1.ExpandProf"
    ActiveSheet.Shapes.Range(Array("Rectangle 5")).Select
    Selection.OnAction = "Sheet1.CollapseProf"
    ActiveSheet.Shapes.Range(Array("Rectangle 6")).Select
    Selection.OnAction = "Sheet1.ExpandMatter"
    ActiveSheet.Shapes.Range(Array("Rectangle 7")).Select
    Selection.OnAction = "Sheet1.CollapseMatter"
    ActiveSheet.Shapes.Range(Array("Rectangle 8")).Select
    Selection.OnAction = "Sheet1.RefreshData"
    Sheets("Previous Business Day").Select
    wbo.Save '~~> save
    wbo.Close '~~> close

'Creates and shows the outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    With oMail
        .To = MailTo
        .Cc = MailCC
        .Bcc = ""
        .Subject = MailSub
        .Body = MailTxt
        .Attachments.Add wb.FullName
        .Send
    End With
     
     'Deletes the temporary file
    wb.ChangeFileAccess Mode:=xlReadOnly
    Kill wb.FullName
    wb.Close SaveChanges:=False
     
     'Restores screen updating and release Outlook
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
End Sub
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
37,145
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS

ADVERTISEMENT

From one r.archibald to another:

When you do this:

Code:
    ActiveWorkbook.Sheets.Copy
    Set WB = ActiveWorkbook

you create a new workbook containing just the worksheets. Is there a reason you can't just save a copy of the workbook (which would include all the code) and then email that?
 

rarchibald

New Member
Joined
May 26, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
From one r.archibald to another:

When you do this:

Code:
    ActiveWorkbook.Sheets.Copy
    Set WB = ActiveWorkbook

you create a new workbook containing just the worksheets. Is there a reason you can't just save a copy of the workbook (which would include all the code) and then email that?

Wow, small world!

The reason is just that I can only find how to copy sheets. I was searching for a way to copy the whole workbook before I asked this question, but could not find anything. Do you know how to do that?
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
37,145
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You could just use Activeworkbook.SaveCopyAs somefilename? That leaves the current workbook open and creates a closed copy in the specified location. You can't change file format with it, but that doesn't appear to be an issue here.
 

Forum statistics

Threads
1,136,770
Messages
5,677,630
Members
419,707
Latest member
Anna vib

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
Top