Microsoft Excel
Back to jkp-ads.com

Ron de Bruin
Excel Automation

Microsoft MVP Program

Lotus Notes: Send worksheets to several recipients

Important message to visitors of this page

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.