Can THIS Email code be modified

[Mister H]

Hi All:

I have been using this code to email a sheet to another user but I now need to expand on it if possible. Right now it just send the one one sheet and whatever VB is contained in that sheet.

Is there any way to modify this code SO IT WILL INCLUDE the VBA Modules when it email the sheet?

I know there are other codes to send the entire workbook but I am hoping that I can just modify this one to include the modules as opposed to inserting a whole new code.

PLEASE let me know if this is doable.

THANKS,
Mark

 

[pedie]

I am not sure what you want...hmmm you said you know how to email the whole book which mean it already has modules included in it...

Do you want to email certian sheets however keep vba modules as you forward or mail this sheet...?

 

[Mister H]

Oops... My apologies. I guess it would be a little difficult to alter a code without seeing it? i forgot to post my code. The code below sends the sheet but not the VBA Modules... I am hoping there is something that can be added to the code so it sends the module as well as the sheet. HOPEFULLY this makes a little more sense.

Sub Mail_Sheet_To_NTRMB()
'Working in 2000-2007
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set Sourcewb = ActiveWorkbook
 
    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007
            'We exit the sub when your answer is NO in the security dialog that you only
            'see  when you copy a sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
 
    'Change all cells in the worksheet to values if you want
    ActiveSheet.Unprotect "invoice"
        With Destwb.Sheets(1).UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells(1).Select
        End With
        Application.CutCopyMode = False
  
        
        'REMOVE Buttons
    ActiveSheet.Shapes("EmailForm").Select
    Selection.Cut
    
    
 
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "[EMAIL="mtr.ot@ontario.ca"]mtr.ot@ontario.ca[/EMAIL]"
            .CC = ""
            .BCC = ""
            .Subject = "ARIR Request form attached for processing"
            .Body = "To Whom It May Concern:  Please find attached a ARIR form for Review and Processing."
            .Attachments.Add Destwb.FullName
            
            .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
 
    'Delete the file you have sent
    Kill TempFilePath & TempFileName & FileExtStr
 
    Set OutMail = Nothing
    Set OutApp = Nothing
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Bye 4 Now,
Mark

 

[pedie]

Once you're back try this.

[/FONT]
[FONT=Courier New]Sub mAIl_activesheet_withMACRO()
    Dim SaveFormat As Long
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim I As Long[/FONT]
[FONT=Courier New]    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With[/FONT]
[FONT=Courier New]    Set Sourcewb = ActiveWorkbook
    SaveFormat = Application.DefaultSaveFormat
    Application.DefaultSaveFormat = 56[/FONT]
[FONT=Courier New]    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
    Destwb.CheckCompatibility = False[/FONT]
[FONT=Courier New]    TempFilePath = Application.DefaultFilePath & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " _
                 & Format(Now, "yyyy-mm-dd hh-mm-ss")[/FONT]
[FONT=Courier New]    With Destwb
        .SaveAs TempFilePath & TempFileName & ".xls", _
                FileFormat:=56
        On Error Resume Next
        For I = 1 To 3
            .SendMail "[/FONT][EMAIL="pedie@live.com"][FONT=Courier New]pedie@live.com[/FONT][/EMAIL][FONT=Courier New]", _
                      "This is the Subject line"
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    Kill TempFilePath & TempFileName & ".xls"
    Application.DefaultSaveFormat = SaveFormat[/FONT]
[FONT=Courier New]    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[Mister H]

THANKS Pedie I will give that code a try as soon as I return to the office.

Do you (or anyone else) know if you can add the body of the message using this method? Also I might need a CC or possible multiple addresses in the To.

Not really sure yet about multiple addresses in the To section or if I Will need to CC anybody but I am pretty sure I Will need a little note in the body if the email. I will know more once I speak with the users of the spreadsheet but thought I would ask while I was on line.

THANKS Again and my apologies for the confusing 1st post

Have a GREAT night,
Mark