Copying VBA Modules Between Workbooks

This is a cross posting of a post I have made at another site. I suspect I may have challenged that group as there hasn't been much along the line of support. Perhaps there is no solution. I thought I'd post here to tap into the skill of a different group hoping to get some direction.

In my VBA project, a worksheet is created, copied to a new book and saved. This worksheet is like an internal user order form and has a few macro embedded shapes on it for use by the user using the form which is emailed to them.

The macros are stored in the workbook that created the initial worksheet. The users receiving the email with the form in it with the macro embedded shapes do not have access to the original creation workbook, so the macros embedded on the attachment they receive are not executable.

How can I send out that document with the macros available to the user? (I know this is can be an unsafe practice from the recipient standpoint, but no harm is intended with these macros.)

My email distribution code is below ...

Sub Mail_workbook_Outlook_3()
    'Working in Excel 2000-2016
    'Mail a changed copy of the ActiveWorkbook with another file name
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Shp As Shape

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Make a copy of the file/Open it/Edit it/Mail it/Delete it

    TempFilePath = Environ$("temp") & "\"
    FileExtStr = "." & LCase(Right(wb_tsrf.Name, Len(wb_tsrf.Name) - InStrRev(wb_tsrf.Name, ".", , 1)))
    fnlen = Len(wb_tsrf.Name)
    fnlen = fnlen - 5
    fn = Left(wb_tsrf.Name, fnlen)
    sn = Worksheets(1).Name
    
    TempFileName = fn & "SR"
    
    wb_tsrf.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)


    '**************Add code to edit the file here********************

    With wb2.Worksheets(1)
        .Unprotect
        For Each Shp In ActiveSheet.Shapes
            'MsgBox Shp.Name
            If Shp.Name = "Group 12" Then
                Shp.Delete
            ElseIf Shp.Name = "Group 3" Then
                Shp.Delete
            End If
        Next Shp
        .Protect
        Set wb_tar = Workbooks(TempFileName & ".xlsx")
        Debug.Print wb_tar.Name
        CopyModule    
    End With
    
    'Save the file after we changed it with the code above
    'wb2.Save
    wb2.SaveAs TempFilePath & TempFileName & ".xlsm"

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

    On Error Resume Next
    With OutMail
        .to = "recipient@email.ca"
        .CC = ""
        .BCC = ""
        .Subject = "### ##### ## SRF (" & sn & ")"
        .Body = "The embedded macros are safe. Choosing to not enable them will not affect the document."
        .Attachments.Add wb2.FullName
        .Send   'or use .Display
    End With
    On Error GoTo 0
    wb2.Close savechanges:=False

    'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    MsgBox "Message has been sent."
    Stop
End Sub

On further research, I found that what I simply (really? simply??) need to do is import the module holding the macros for the buttons from the master workbook to the target. The code in the macros is not written with any public variables or direct references to specific source worksheets etc. (all references are to activesheet or activeworkbook in the macros).

Here is the code (thanks to ExcelTips)to copy the module (which doesn't seem to be working)

Sub CopyModule() '(SourceWB As Workbook, strModuleName As String, _
    TargetWB As Workbook)

Dim strFolder As String, strTempFile As String
    strFolder = wb_mat.Path 'source workbook
    strModuleName = "Module4.bas"
    If Len(strFolder) = 0 Then strFolder = CurDir
    strFolder = strFolder & "\"
    strTempFile = strFolder & "Module4.bas"
    On Error Resume Next
    wb_mat.VBProject.VBComponents(strModuleName).Export strTempFile
    wb_tar.VBProject.VBComponents.Import strTempFile
    Kill strTempFile
    On Error GoTo 0
End Sub

Questions ....

1) Can anyone provide a solution as to why the exporting of the module isn't happening? There are no errors, it just doesn't happen.
2) The line is giving me an error ("Method 'SaveAs' of object '_Workbook' failed.") . It's trying the save the workbook with the newly imported module as an .xlsm file (which I believe if you have macros has to be saved as). I'm assuming it's failing because there are no macros associated with that workbook since the import failed. If issue #1 is taken care of, will that eliminate this error? Or will I still have this error? What could I do then?

Thank you in advance for your consideration!

.
One thing that will assist in troubleshooting any macro is to comment out (or delete entirely) the line "On Error Resume Next".

I did not review the email code for accuracy but I am presuming if you got it from Ron deBruin's site it is good. He does have an
example of making a copy of the existing workbook and attaching it to the email for sending.

Hi! Thanks so much for stepping in to offer assistance!

Logit ... I commented out the line you pointed out in the CopyModule code. It stopped on this line with the error "Method 'VBProject' of object '_Workbook' failed. This is a new one for me.

wb_mat.VBProject.VBComponents(strModuleName).Export strTempFile

Andy, your approach seems simple enough so I gave it a go. I moved the simple lines of code for the shapes into that worksheet's object code. BTW, here is the code for the macro emedded buttons on the worksheet being copied to a new book.

Sub Group6_Click() 'PRINT
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

Sub Group9_Click() 'CLOSE
    With ActiveWorkbook
        ActiveSheet.Protect
        .Save
        .Close
    End With
End Sub

The CopyModule code is eliminated altogether from the emailing code.

However, I run into a problems even before this associated with saving the copied workbook initially. The process of copying the worksheet to a new book is initially created in this module. (This creation is not the one that is emailed. The one emailed is the same worksheet but has some button functionality disabled for the recipient). Refer to this code ...

Private Sub uf2_create_Click()
    Dim f_range As Range
    
    ...
        
    m1 = Application.WorksheetFunction.Match(uf2_srf.uf2cb_worange.Value, ws_sheet2.Range("O2:O21"), 0)
    rng_low = Application.WorksheetFunction.Index(ws_sheet2.Range("K2:O21"), m1, 1)
    rng_hi = Application.WorksheetFunction.Index(ws_sheet2.Range("K2:O21"), m1, 2)
    sname = Format(rng_low, "ddmmmyy") & "-" & Format(rng_hi, "ddmmmyy")
    
    Application.ScreenUpdating = False
    With ws_srf
        .Visible = True
        .Copy
        .Visible = False
    End With
    Application.ScreenUpdating = True
    ActiveSheet.Name = sname
    Set ws_tsrf = Worksheets(sname)
    
    With ws_tsrf
        .Unprotect
        sname = "SRF_WP_" & sname & ".xlsx"
        fname = "H:\Materials Tracking\Reports\" & sname
        ui1 = InputBox("Please enter user's initials:", vbInformation, "REQUIRED INFORMATION")
        .Range("AB1") = uf2_srf.uf2cb_worange.Value
        .Range("B32") = "   substance (" & un1 & ")"
        
        tr = 8
        nr = 0
        For i = 51 To 72
            If ws_sheet2.Cells(i, 3) > 0 Then
                .Cells(tr - 1, 1) = "90000"
                .Cells(tr - 1, 3) = "Salt"
                .Cells(tr - 1, 2) = ws_sheet2.Cells(i, 3)
                .Cells(tr - 1, 4) = ui1
                wo = ws_sheet2.Cells(i, 2)
                    .Cells(tr, 11) = Right(wo, 1)
                    .Cells(tr, 10) = Mid(wo, 5, 1)
                    .Cells(tr, 9) = Mid(wo, 4, 1)
                    .Cells(tr, 8) = Mid(wo, 3, 1)
                    .Cells(tr, 7) = Mid(wo, 2, 1)
                    .Cells(tr, 6) = Left(wo, 1)
                nr = nr + 1 'change to 1
                If nr = 12 Then 'add page
                    .Rows("1:33").Copy .Range("34:34")
                    .Range("A41:AN64") = ""
                    tr = 41
                Else
                    tr = tr + 2
                End If
            End If
        Next i
        .Protect
        
        MsgBox "New report visible behind this window.", vbExclamation, "REPORT COMPLETED"
        uf2_srf.uf2_create.Enabled = False
        .SaveAs Filename:=fname
        Set wb_tsrf = Workbooks(sname)
        
    End With
    
End Sub

This code breaks at the line in red when it tries to save. Since the new workbook has vb associuated to it (in the worksheet object) it will not allow it to save with that (.xlsx) extension.
If I change the extension to ".xlsm" in the line in blue ... I get "This extension can not be used with the selected file type. Change the file extension in the File name text box or select a different file type by changing the Save as type." as in breaks at the same line as above in red. It doesn't appear as though I can save the newly created workbook with the vba in the sheet.

It would appear that I have managed to overcomne the file extension related hurdle after a decent Google search.

I added the argument " FileFormat:=XlFileFormat.xlOpenXMLWorkbookMacroEnabled " which seems to have done the trick.

Jenn68

Great ! You have it working for you. Good feeling .. huh ?

What was the solution to : with the error "Method 'VBProject' of object '_Workbook' failed.

Hi again folks ...
So I thought I had things good to go. My worksheet (with code attached to the sheet object for the two macro enabled shapes on it) was copied to a new workbook and saved successfully as a .xlsm file. It gets sent off to the recipient.
The recipient opens the file and enables macros as prompted. However, when they click on the macro enabled button, they get the message "Cannot run the macro ''SRF_WP_07Jan19-13Jan19.xlsm'!SRF_Group6_Click'. The macro may not be available in this workbook or all macros may be disabled."

The workbook name matches, the only worksheet in the workbook is "SRF" There are two macro enabled shapes available to the user upon receipt of the workbook.

Sub Group6_Click() 'PRINT
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

Sub Group9_Click() 'CLOSE
    With ActiveWorkbook
        ActiveSheet.Protect
        .Save
        .Close
    End With
End Sub

I do not have the same issue with the "Sub Group9_Click" macro.

Any thoughts?

Hi Andy. Your suggestion has revealed that I get the same error on the original.
I should have checked there first as it was easy then to dsicover the problem

Thanks for the hint!