inserting a macro into a Tempfile

[mcantrell]

I have a macro that extracts a worksheet then inserts it into a tempfile then uses outlook to send the worksheet.

What I am having problems with is inserting a macro in the Tempfile that the person who is recieving the file can use to protect the worksheet after they have made their adjustments and then email the file.

basically this would amount too inserting a macro into a macro

[mojo249]

Hi

I use the following code to export a sheet ("EmailFile") to a new workbook, then export Module1 (which contains the code that I want to copy over) from ThisWorkbook into the newly created workbook.

Obviously you'll need to customise it to your needs. Hopefully the comments help explain what each section does.

Dion

Private Sub CreateAttachment()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

On Error Resume Next

'Make sure C:\Temp folder exists
If Len(Dir("C:\Temp", vbDirectory)) = 0 Then
    MkDir "C:\Temp"
End If

'Export module 1
If Dir("C:\Temp\MrXL1.bas") <> "" Then
    Kill ("C:\Temp\MrXL1.bas")
End If
On Error GoTo 0
ThisWorkbook.VBProject.VBComponents("Module1").Export ("C:\Temp\MrXL1.bas")

'Copy required sheets to new workbook
    ThisWorkbook.Sheets("EmailFile").Copy
    
    Set varNewWorkbook = ActiveWorkbook

    'Delete all code in new workbook
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        
        Set VBProj = varNewWorkbook.VBProject
        
        For Each VBComp In VBProj.VBComponents
            If VBComp.Type = vbext_ct_Document Then
                Set CodeMod = VBComp.CodeModule
                With CodeMod
                    .DeleteLines 1, .CountOfLines
                End With
            Else
                VBProj.VBComponents.Remove VBComp
            End If
        Next VBComp

    ' Import Module 1 to the new workbook
    varNewWorkbook.Activate
    Application.VBE.ActiveVBProject.VBComponents.Import ("C:\Temp\MrXL1.bas")
    If Dir("C:\Temp\MrXL1.bas") <> "" Then
        Kill ("C:\Temp\MrXL1.bas")
    End If

'Check if directory exists
varDirectory = "C:\Temp"
varNewFileName = varDirectory & "\CHAPS Request - " & frmRequest.txtPayee.Text & ".xls"
If Dir(varDirectory, vbDirectory) = "" Then
    MkDir varDirectory
End If

'Update macros linked to buttons
varNewWorkbook.Activate
Sheets("EmailFile").Select
ActiveSheet.Shapes("Button 1").Select
Selection.OnAction = varNewFileName & "!Module1.SendEmailApproved"
ActiveSheet.Shapes("Button 2").Select
Selection.OnAction = varNewFileName & "!Module1.SendEmailRejected"
Range("A1").Select

'Save workbook as Excel 2003 file
Sheets("EmailFile").Select
ActiveSheet.Name = "CHAPSRequest"
varNewWorkbook.SaveAs Filename:=varNewFileName _
    , FileFormat:=xlNormal, ReadOnlyRecommended:=False, CreateBackup:=False

varNewWorkbook.Close False

Application.DisplayAlerts = True

End Sub