1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
| Sub EnvoiEmailXLS()
Dim MaDate As String
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
Dim vaMsg As Variant
Dim StrSignature As Variant
Dim stSubject As String
On Error GoTo TraiteErreur
stSubject = "sujet à mentionner"
MaDate = Date
vaMsg = "Bonjour, " & vbCrLf & vbCrLf & vbCrLf & _
vbCrLf & vbCrLf & vbCrLf & vbCrLf _
& "Bonne réception." & vbCrLf _
& "Cordialement."
stFileName = "test"
stAttachment = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
'test de l'existance de la PJ
If Dir(stAttachment) = "" Then GoTo TraitePJ
vaRecipients = ""
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
.Body = vaMsg
.SAVEMESSAGEONSEND = True
.PostedDate = Now()
End With
'Affichage du mail dans Lotus Notes.
Dim Workspace
Set Workspace = CreateObject("Notes.NotesUIWorkspace")
Call Workspace.EditDocument(True, noDocument).FieldSetText("Body", vaMsg)
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing |
Partager