Back to jkp-ads.com |
Ron de Bruin
|
Ron de Bruin decided to remove all Windows Excel content from his website for personal reasons. If you want to know why, head over to rondebruin.nl.
Luckily, Ron was kind enough to allow me to publish all of his Excel content here.
Most of these pages are slightly outdated and may contain links that don 't work. Please inform me if you find such an error and I'll try to fix it.
Kind regards
Jan Karel Pieterse
The code examples on this page are created by Excel MVP Dennis Wallentin
but are not on his site anymore. But Dennis allow me to publish it on my
site for all the Excel/Lotus Notes users in the world.
The
information in this article applies to:
Microsoft Excel 2000 and
later.
Lotus Notes 7.01 and later.
Task:
I
have been receiving some e-mails on how to send individual worksheets to
several groups of recipients. In this example each worksheet contain the
list of recipients to send the actual worksheet to.
The case also
includes a general error handling.
VBA code :
Option Explicit Sub Send_Sheets_Notes_Email() 'Notes parameter for attaching the Excel files. Const EMBED_ATTACHMENT As Long = 1454 'A folder to temporarily store the created Excel files in. Const stPath As String = "c:\Attachments" 'The subject for the outgoing e-mails. Const stSubject As String = "Weekly report" 'The message in the bodies of the outgoing e-mails. Const vaMsg As Variant = "The weekly report as per agreement." & vbCrLf & _ "Kind regards," & vbCrLf & _ "Dennis" 'Variable that holds the list of recipients for each worksheet. Dim vaRecipients As Variant 'Variable which holds each worksheet's name. Dim stFileName As String 'Variables for Notes. Dim noSession As Object Dim noDatabase As Object Dim noDocument As Object Dim noEmbedObject As Object Dim noAttachment As Object Dim stAttachment As String 'Variables for Excel. Dim wbBook As Workbook Dim wsSheet As Worksheet Dim lnLastRow As Long On Error GoTo Error_Handling Application.ScreenUpdating = False Set wbBook = ThisWorkbook 'Loop through the collection of worksheets in the workbook. For Each wsSheet In wbBook.Worksheets With wsSheet 'Copy the worksheet to a new workbook. .Copy 'Retrieve the worksheet's name. stFileName = .Name End With 'Create the full path and name of the workbook. stAttachment = stPath & "\" & stFileName & ".xls" 'Save and close the temporarily workbook. With ActiveWorkbook .SaveAs stAttachment .Close End With 'Retrieve the list of recipients. With wsSheet lnLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row vaRecipients = .Range("A1:A" & lnLastRow).Value End With 'Instantiate the Lotus Notes COM's Objects. Set noSession = CreateObject("Notes.NotesSession") Set noDatabase = noSession.GETDATABASE("", "") 'If Lotus Notes is not open then open the mail-part of it. If noDatabase.IsOpen = False Then noDatabase.OPENMAIL 'Create the e-mail and add the attachment. Set noDocument = noDatabase.CreateDocument Set noAttachment = noDocument.CreateRichTextItem("stAttachment") Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment) 'Add values to the created e-mail main properties. With noDocument .Form = "Memo" .SendTo = vaRecipients .Subject = stSubject .Body = vaMsg .SaveMessageOnSend = True .PostedDate = Now() .Send 0, vaRecipients End With 'Delete the temporarily workbook. Kill stAttachment Next wsSheet MsgBox ("The e-mails have successfully been created and distributed."), vbInformation ExitSub: 'Release objects from memory. Set noEmbedObject = Nothing Set noAttachment = Nothing Set noDocument = Nothing Set noDatabase = Nothing Set noSession = Nothing Exit Sub Error_Handling: MsgBox "Error number: " & Err.Number & vbNewLine & _ "Description: " & Err.Description, vbOKOnly Resume ExitSub End Sub
Comments:
The above example shows how it's possible
to create a flexible solution to send individual
worksheets to several
groups of recipients.