Can THIS Email code be modified

Mister H

Well-known Member
Joined
Mar 6, 2002
Messages
1,507
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 :)
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

pedie

Well-known Member
Joined
Apr 28, 2010
Messages
3,875
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

Well-known Member
Joined
Mar 6, 2002
Messages
1,507
Oops... :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.


Code:
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

Well-known Member
Joined
Apr 28, 2010
Messages
3,875
Once you're back try this.:)
Code:
[/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

Well-known Member
Joined
Mar 6, 2002
Messages
1,507
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? :confused: 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
 

Forum statistics

Threads
1,141,144
Messages
5,704,544
Members
421,354
Latest member
Canary99

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