Help to add a loop in e-mailing worksheets

[AMS22]

I have implemented the below VBA code to e-mail a single worksheet to the intended recipient (with Lotus Notes - ugh). However, it only will work on one sheet at a time. I would like to be able to select multiple sheets and have the macro run through all of them.

I'm very new to VBA, but so far I've been having a lot of fun learning! This one stumps me! Please help!

Option Explicit

Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "C:\Temp"
Const stSubject As String = "Field Campaign Open Orders - "
Const vaMsg As Variant = "Please see the attached Open Field Campaign Orders." & vbCrLf & _
"Thanks," & vbCrLf & _
"Katie"

Sub Send_Active_Sheet()

Dim stFileName As String
Dim vaRecipients As Variant

Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String

'Copy the active sheet to a new temporarily workbook.
With ActiveSheet
.Copy
stFileName = Range("I2")
End With

stAttachment = stPath & "\" & stFileName & ".xls"

'Save and close the temporarily workbook.
With ActiveWorkbook
.SaveAs stAttachment
.Close
End With

'Create the list of recipients.
vaRecipients = Range("Q2")

'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 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 & Range("I2")
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With

'Delete the temporarily workbook.
Kill stAttachment

'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

MsgBox "The e-mail has successfully been created and distributed", vbInformation

End Sub

 

[John_w]

I would like to be able to select multiple sheets and have the macro run through all of them.

I'm not sure what you're asking for.

Do you want to generate a single email with one workbook attachment containing multiple sheets? Or a single email with multiple workbook attachments, each containing one sheet? Or multiple emails each with a single workbook attachment containing one sheet? Do the sheets have specific names or indexes (positions) in your workbook?

 

[AMS22]

I'm not sure what you're asking for.

Do you want to generate a single email with one workbook attachment containing multiple sheets? Or a single email with multiple workbook attachments, each containing one sheet? Or multiple emails each with a single workbook attachment containing one sheet? Do the sheets have specific names or indexes (positions) in your workbook?

Sorry John_w - I should have been more specific. It is my preference to send multiple e-mails, each to a unique recipient with 1 unique attachment (the worksheet from the book). All the worksheets have their own unique name.

For example, each tab would be called by the region or location and should be e-mailed to the coordinating manager. (The recipient e-mail address is currently being referenced through the worksheet).
</SPAN>
Just to give a little more background - I start with one master tab, then by running a different macro, it creates multiple new tabs based on the unique values in a given column (region or branch) and names them accordingly. I may not have the same number of tabs each time, and the names could change. I hope that makes sense, please let me know if you have another question. </SPAN>

 

[John_w]

Try this code. I've assumed that the master sheet is named "Master" (case insensitive). This sheet is not emailed. Just change the relevant line in the code if it has a different name.

Option Explicit

Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "C:\Temp"
Const stSubject As String = "Field Campaign Open Orders - "
Const vaMsg As Variant = "Please see the attached Open Field Campaign Orders." & vbCrLf & _
"Thanks," & vbCrLf & _
"Katie"


Public Sub Send_All_Sheets()

    Dim ws As Worksheet
    Dim stFileName As String
    Dim vaRecipients As Variant
    Dim noSession As Object
    Dim noDatabase As Object
    Dim noDocument As Object
    Dim noEmbedObject As Object
    Dim noAttachment As Object
    Dim stAttachment As String
    
    '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
    
    For Each ws In Worksheets
        If UCase(ws.Name) <> "MASTER" Then
        
            'Copy this sheet to a new temporary workbook.
            ws.Copy
            stFileName = ws.Range("I2").Value
            stAttachment = stPath & "\" & stFileName & ".xls"
    
            'Save and close the temporary workbook.
            With ActiveWorkbook
                .SaveAs stAttachment
                .Close
            End With
    
            'Create the list of recipients.
            vaRecipients = ws.Range("Q2").Value
    
            'Create the e-mail and 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 = Split(vaRecipients, ",")
                .Subject = stSubject & stFileName
                .Body = vaMsg
                .SaveMessageOnSend = True
                .PostedDate = Now
                .Send 0, vaRecipients
            End With
    
            'Delete the temporary workbook.
            Kill stAttachment
    
            MsgBox "Sent email with " & stFileName & ".xls attached to " & vaRecipients, vbInformation
    
        End If
    Next
    
    'Release objects from memory.
    Set noEmbedObject = Nothing
    Set noAttachment = Nothing
    Set noDocument = Nothing
    Set noDatabase = Nothing
    Set noSession = Nothing

End Sub

 

[AMS22]

Yes! Perfect!

Thanks so much for your help!