davylenders123
Gebruiker
- Lid geworden
- 20 jun 2010
- Berichten
- 902
Ik heb op de site van ron een code gevonden voor een werkmap door te mailen met lotus notus via excel.
Ik weet echter niet goed waar de mail adressen moeten komen staan .
Kan iemand mij hier mee verder helpen.
Ik weet echter niet goed waar de mail adressen moeten komen staan .
Kan iemand mij hier mee verder helpen.
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
:thumb:
