VBA to include modules in emailed workbook

[rarchibald]

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

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

 

[severynm]

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

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]

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

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]

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?

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]

From one r.archibald to another:

When you do this:

    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]

From one r.archibald to another:

When you do this:

    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]

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.