Help to add a loop in e-mailing worksheets

AMS22

New Member
Joined
Feb 7, 2014
Messages
7
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!



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

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,121
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

New Member
Joined
Feb 7, 2014
Messages
7
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

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,121
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.
Code:
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
 
Learn Excel from Bill Jelen

Understanding data is crucial, and the easiest place to start is with Microsoft Excel.

Forum statistics

Threads
1,151,588
Messages
5,765,303
Members
425,271
Latest member
kristyfinn

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