Excel

Email Activesheet in Body of Mail Using Default Mailer.

Ease of Use

Intermediate

Version tested with

2000 

Submitted by:

johnske

Description:

On opening the workbook two temporary control buttons are placed on the RHS of the worksheet menu bar. On clicking the 'Email Active Sheet' button a temporary toolbar with 5 options appears. On selecting one of the 'Send' options the active sheet is emailed in the body of the email to the specified recipient (or recipients) using the users default mailer (Outlook, Outlook Express, ..., etc). NOTE: Requires Office 2000 or greater 

Discussion:

A common question in Help forums is "how to automate emailing the active sheet in the body of an email". The usual solution given (See http://www.rondebruin.nl/mail/folder3/mail2.htm) utilizes Outlook, and the solution given there involves a process of deleting all shapes and converting values to text, needless to say, charts can't be sent in this manner. So if the sheet to send relies heavily on formatting, charts, images, and shapes for presentation purposes, all of that is lost... In addition, if you don't use Outlook as your default emailer and you're using that code you may think that you have emailed it - but you haven't - it's actually just sitting in the Outlook outbox waiting for you to open Outlook so it can be sent.... Excel provides an inbuilt tool that circumvents all these difficulties, but this requires you to click a few buttons on your toolbar to activate the process, which is often not considered adequate when the process is to be fully automated and activated by code. This entry uses code that "clicks the buttons" for the user and sends the email. The only variation from 'normal' usage here is that the recipients(s) can't be written into the code itself, however, we can make use of the fact that once it's been saved, the workbook remembers the last recipients that the workbook was sent to and automatically sends it to the same recipients every time the code is actuated. What this means is that there is actually no need to write the recipients name into the code, instead, the recipients are written in the "To:" field of the mailer the very first time it is sent. When the code is actuated after that, it gives the options to i) use the same recipients, ii) ALWAYS use the same recipients without asking again, or, iii) to change them in the To: field whenever the code is actuated. It's suggested that this code be placed in Personal.xls and used whenever you wish to send the active sheet in any active workbook. SPECIAL NOTE: Any hyperlinks used for navigating about the active sheet will still work on the emailed sheet 

Code:

instructions for use 

			
 '      '           << CODE FOR THISWORKBOOK MODULE >>
 '***************************************
 
 '     '<<----------------<< THISWORKBOOK CODE >>---------------->>
 
 '     'If required as a permanent feature the code can be pasted
 '     'in PERSONAL.XLS and used for any active workbook...
 
 '     'NOTE: If you have clicked the "never show" button and later wish to change
 '     'the recipients in that workbook, go to File > Properties > Summary in that
 '     'workbook and delete the "NeverShow" displayed in the Summary field...
 
Option Explicit 
 
 
Private Sub Workbook_Open() 
     
    Dim NewButton As CommandBarButton 
     '---------------------------------------------------------------------------
     '//delete any pre-existing instance of the toolbar & buttons\\
    On Error Resume Next 
    Run ("DeleteToolbar") 
    Call DeleteAddedButtons 
     '---------------------------------------------------------------------------
     '//add a button as the second-last item on the main menu bar\\
    Set NewButton = Application.CommandBars("Worksheet Menu Bar") _ 
    .Controls.Add(Type:=msoControlButton) 
    With NewButton 
        .Caption = "&Email Active Sheet" 
        .OnAction = "SendActiveSheet" 
        .TooltipText = "Email Active Sheet in Body" 
        .Style = msoButtonIconAndCaption 
        .FaceId = 24 
    End With 
    Set NewButton = Nothing 
     '---------------------------------------------------------------------------
     '//add a button as the last item on the main menu bar\\
    Set NewButton = Application.CommandBars("Worksheet Menu Bar") _ 
    .Controls.Add(Type:=msoControlButton) 
    With NewButton 
        .Caption = "Cancel &Email" 
        .OnAction = "EscapeProcedure" 
        .TooltipText = "Return to normal window" 
        .Style = msoButtonIconAndCaption 
        .FaceId = 51 
        .Enabled = False 
    End With 
    Set NewButton = Nothing 
     '---------------------------------------------------------------------------
End Sub 
 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
     '     '---------------------------------------------------------------------------
     '     '//delete any pre-existing instance(s) of the toolbars\\
    On Error Resume Next 
    Run ("DeleteToolbar") 
    Call DeleteAddedButtons 
     '---------------------------------------------------------------------------
End Sub 
 
 
Private Sub DeleteAddedButtons() 
     '     '---------------------------------------------------------------------------
     '     '//delete the main menu buttons\\
    On Error Resume Next 
    With Application.CommandBars("Worksheet Menu Bar") 
        .Controls("Email Active Sheet").Delete 
        .Controls("Cancel &Email").Delete 
    End With 
     '---------------------------------------------------------------------------
End Sub 
 
 '***************************************
 
 
 '      '                << CODE FOR STANDARD MODULE >>
 '***************************************
 '     '<<--------------------<< MODULE1 CODE >>-------------------->>
Option Explicit 
 
Sub SendActiveSheet() 
     '     '---------------------------------------------------------------------------
     '     '//no need for toolbar if book's marked "NeverShow" - check\\
    With ActiveWorkbook 
        Select Case .BuiltinDocumentProperties("Comments") 
        Case "NeverShow" 
            Call AutoSend 
            Exit Sub '< end this procedure right here
        Case "Initialized" 
             '//if not already in email mode build the toolbar\\
            If Not .EnvelopeVisible Then GoSub BuildToolbar 
        Case Else 
            If Not .EnvelopeVisible Then 
                .BuiltinDocumentProperties("Comments") = "FirstTime" 
                GoSub BuildToolbar 
            End If 
        End Select 
        Exit Sub 
    End With 
     '---------------------------------------------------------------------------
BuildToolbar: 
     '//the toolbar's needed, create it\\
    Dim FloatingBar As CommandBar 
    Dim NewButton As CommandBarButton 
     '---------------------------------------------------------------------------
     '//delete any pre-existing instance of the toolbar\\
    On Error Resume Next '< error = no bar to delete
    Call DeleteToolbar 
    On Error GoTo 0 '< cancel error trapping
     '---------------------------------------------------------------------------
     '//create floating command bar\\
    Set FloatingBar = CommandBars.Add 
    With FloatingBar 
        .Name = "Email Activesheet in Body of Email" 
        .Position = msoBarFloating 
        .Visible = True 
        .Top = 200 
        .Left = 200 
    End With 
     '---------------------------------------------------------------------------
     '//add buttons to the command bar\\
    Set NewButton = FloatingBar.Controls.Add(Type:=msoControlButton) 
    With NewButton 
        .Caption = "CANCEL" 
        .OnAction = "ExitSub" 
        .TooltipText = "Click to cancel operation" 
        .Style = msoButtonIconAndWrapCaptionBelow 
        .FaceId = 463 
    End With 
     
    With ActiveWorkbook 
         '//----------------------------------------------------------\\
         '(this button not needed the very first time the code is executed)
        If .BuiltinDocumentProperties("Comments") = "Initialized" Then 
            Set NewButton = FloatingBar.Controls.Add(Type:=msoControlButton) 
            With NewButton 
                .Caption = "Send the active sheet to the same recipients as last time..." 
                .TooltipText = "Use the same email addresses" 
                .OnAction = "AutoSend" 
                .Style = msoButtonIconAndWrapCaptionBelow 
                .FaceId = 45 
            End With 
        End If 
         '\\----------------------------------------------------------//
         
        Set NewButton = FloatingBar.Controls.Add(Type:=msoControlButton) 
        With NewButton 
            .Caption = "Send the active sheet to some new recipients" 
            .TooltipText = "Don't use the same email addresses" 
            .OnAction = "ManualSend" 
            .Style = msoButtonIconAndWrapCaptionBelow 
            .FaceId = 24 
        End With 
         
         '//----------------------------------------------------------\\
         '(this button not needed the very first time the code is executed)
        If .BuiltinDocumentProperties("Comments") = "Initialized" Then 
            Set NewButton = FloatingBar.Controls.Add(Type:=msoControlButton) 
            With NewButton 
                .Caption = "I'm not sure who the active sheet was sent to last time. Show me.." 
                .TooltipText = "Show me the last recipients" 
                .OnAction = "ManualSend" 
                .Style = msoButtonIconAndWrapCaptionBelow 
                .FaceId = 487 
            End With 
        End If 
         '\\----------------------------------------------------------//
         
        Set NewButton = FloatingBar.Controls.Add(Type:=msoControlButton) 
        With NewButton 
            .Caption = "ALWAYS send the active sheet to these recipients and NEVER show me this toolbar again!" 
            .TooltipText = "Automate this operation" 
            .OnAction = "NeverShowAgain" 
            .Style = msoButtonIconAndWrapCaptionBelow 
            .FaceId = 536 
        End With 
    End With '< With ActiveWorkbook
     
    Set FloatingBar = Nothing 
    Set NewButton = Nothing 
     '---------------------------------------------------------------------------
End Sub 
 
 
Private Sub AutoSend() 
     '      '---------------------------------------------------------------------------
     '     '//delete the toolbar and send\\
    Call DeleteToolbar 
    DoEvents '< allow a repaint
     '---------------------------------------------------------------------------
     '//send the sheet\\
    With Application 
        .ScreenUpdating = False 
        On Error Resume Next 
        With .CommandBars("Send To") 
             '//IF the control "Send Now" is missing the code will error out, so add it\\
            .Controls.Add Type:=msoControlButton, ID:=3708 
            .Controls("Mail Recipient").Execute 
            DoEvents 
            With .Controls("Send Now") 
                 '//sends activesheet in email body\\
                .Execute 
                 '//remove the "Send Now" control added for this procedure\\
                .Delete 
            End With 
        End With 
        .ScreenUpdating = True 
    End With 
     '---------------------------------------------------------------------------
End Sub 
 
 
Private Sub ManualSend() 
    Call DeleteToolbar 
    DoEvents 
     '----------------------------------------------------------------------
     '//change properties & execute\\
    With ActiveWorkbook 
         
        If .BuiltinDocumentProperties("Comments") = "FirstTime" Then 
            .BuiltinDocumentProperties("Comments") = "Initialized" 
            Application.DisplayAlerts = False 
            .Save 
            Application.DisplayAlerts = True 
             '//show the mail window\\
            .EnvelopeVisible = True 
             '//wait for the mail window to appear\\
            Do Until .EnvelopeVisible 
            Loop 
             '//(don't enable the 'Cancel' button - it doesn't work for this instance)\\
             '//give basic instructions for first timers\\
            MsgBox "Enter recipients in the 'To:' field then click" & vbNewLine & _ 
            "the ''Send this Sheet'' button on the left..." & vbNewLine & _ 
            "" & vbNewLine & _ 
            "(Note: For this time only, to cancel email go" & vbNewLine & _ 
            "to 'File' - 'Send To' and click 'Mail Recipient')", , "INSTRUCTIONS..." 
        Else 
             '//show the mail window\\
            .EnvelopeVisible = True 
             '//wait for the mail window to appear\\
            Do Until .EnvelopeVisible 
            Loop 
             '//now enable the 'Cancel' button\\
            Application.CommandBars("Worksheet Menu Bar").Controls("Cancel &Email").Enabled = True 
        End If 
         
    End With 
     '----------------------------------------------------------------------
End Sub 
 
 
Private Sub NeverShowAgain() 
    Call DeleteToolbar 
     '---------------------------------------------------------------------------
     '//Mark workbook so as to never show the toolbar, save and send the sheet\\
    With ActiveWorkbook 
        Select Case .BuiltinDocumentProperties("Comments") 
        Case "FirstTime" 
            .BuiltinDocumentProperties("Comments") = "NeverShow" 
             '//save the changed property\\
            Application.DisplayAlerts = False 
            .Save 
            Application.DisplayAlerts = True 
            Call ManualSend 
        Case "Initialized" 
            .BuiltinDocumentProperties("Comments") = "NeverShow" 
             '//save the changed property\\
            Application.DisplayAlerts = False 
            .Save 
            Application.DisplayAlerts = True 
            Call AutoSend 
        End Select 
    End With 
     '---------------------------------------------------------------------------
End Sub 
 
 
Private Sub ExitSub() 
     '     '//Just delete the toolbar\\
    Call DeleteToolbar 
End Sub 
 
 
Private Sub DeleteToolbar() 
     '     '---------------------------------------------------------------------------
     '     '//delete the added toolbar\\
    On Error Resume Next 
    Application.CommandBars("Email Activesheet in body of email").Delete 
     '---------------------------------------------------------------------------
End Sub 
 
 
Private Sub EscapeProcedure() 
     '     '---------------------------------------------------------------------------
     '     '//close the email window if visible\\
    ActiveWorkbook.EnvelopeVisible = False 
     '//disable the cancel email button (visible or not)\\
    Application.CommandBars("Worksheet Menu Bar").Controls("Cancel &Email").Enabled = False 
     '---------------------------------------------------------------------------
End Sub 
 
 '***************************************
 
 
 
 
 '=========================================
 '      'Shown below is a much simpler variation
 '      'that can be called by another procedure
 '=========================================
 
Option Explicit 
 
Sub SendSheetProgrammatically_Example() 
     
     '     'This example sends the sheet programmatically, if desired,
     '     'this procedure can be called from within another procedure
     
     '     'NOTE: if this is the very first time this workbook has been sent, the
     '     'application will display a small dialog box (click OK) and a new window
     '     'will then appear. The "To:" field then has to be completed by the user
     '     'before clicking the "Send this Sheet" button on the left.
     
     '     'If an error is made, such as sending the sheet to the wrong recipients,
     '     '(or if at any later time you wish to change the current recipients), you
     '     'can either go to File > Send To > Mail Recipient or, alternatively, go to
     '     'File > Properties > Summary in the workbook and delete the "SentBefore"
     '     'displayed in the Summary field and run procedure that sends the sheet.
     
     '     'When the action has been completed properly, SAVE the workbook and
     '     'all of the recipients will be saved also. Those dialogs then never appear
     '     'again after the first successful send and save - the active sheet in this
     '     'workbook will automatically be sent to those same recipients...
     
    With Application 
        .ScreenUpdating = False 
        On Error Resume Next 
        Select Case ActiveWorkbook.BuiltinDocumentProperties("Comments") 
        Case Is <> "SentBefore" 
             '//show the mail envelope\\
            With ActiveWorkbook 
                .EnvelopeVisible = True 
                 '//mark the workbook as being sent previously\\
                .BuiltinDocumentProperties("Comments") = "SentBefore" 
            End With 
        Case "SentBefore" 
             '//activate the mail window (screen updating=false keeps it hidden)\\
            ActiveWorkbook.EnvelopeVisible = True 
            With .CommandBars("Send To") 
                 '//IF the control "Send Now" is missing the code will error out, so add it\\
                .Controls.Add Type:=msoControlButton, ID:=3708 
                With .Controls("Send Now") 
                     '//sends activesheet in email body\\
                    .Execute 
                     '//remove the "Send Now" control added for this procedure\\
                    .Delete 
                End With 
            End With 
        End Select 
        .ScreenUpdating = True 
    End With 
     
End Sub 
 '=========================================

How to use:

  1. Open an Excel workbook
  2. Select Tools/Macro/Visual Basic Editor (VBE)
  3. Select Insert/Module, copy and paste the code (above) for the standard module in this modules code pane
  4. Select View/Project Explorer, double-click 'ThisWorkbook' and paste the code for the ThisWorkbook module into the code pane that appears.
  5. Now select File/Close and Return To Microsoft Excel
  6. Save your work.
  7. Close and re-open the workbook to create the "Email Active Sheet" button on the main toolbar (located on the far right)
 

Test the code:

  1. Download the attachment, extract and open the MailSheet workbook
  2. Select any sheet and click 'Email Active Sheet'.
  3. A toolbar with 3 buttons will appear, click the central button.
  4. The very first time this code is run a small dialog box will then appear, Click OK or Cancel
  5. Type the recipient(s) into the 'To' field and click the 'Send This Sheet' button.
  6. Select another sheet, a toolbar with 5 buttons will appear, click the button of your choice.
  7. (To add functionality to Excel, the code above can be pasted into Personal.xls and the "Email Active Sheet" button and all the email options are then available every time a workbook is opened).
  8. The attachment also includes two other workbooks, one gives one method for inserting a message into the sheet to be sent.
 

Sample File:

EmailSheet.zip 122.47KB 

Approved by mdmackillop


This entry has been viewed 374 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express