Sub Macro1()
'
'
Dim oSess As Object
Dim oDB As Object
Dim oDoc As Object
Dim oItem As Object
' Variable TEXTE
Dim ntsServer As String
Dim ntsMailFile As String
'
Dim EMailSendTo As String
Dim EMailCopyTo As String
Dim EMailSubject As String
Dim MailPJ As String
Dim LotusSRV As String
Dim WbkName As String
On Error GoTo err_SendNotesMsg
' Initialisation des variables
EMailSendTo = "xxx@xxx.com"
EMailCopyTo = "xxx@xxx.com"
EMailSubject = "sujet du message"
' Créer une nouvelles session Notes
Set oSess = CreateObject("Notes.NotesSession")
'Récupérer le nom du serveur
ntsServer = oSess.GetEnvironmentString("serveur de votre lotus", True)
'Acquière le nom du fichier mailfile de l'utilisateur courant dans Notes.ini
ntsMailFile = oSess.GetEnvironmentString("MailFile", True) 'remplacé MailFile
Set oDB = oSess.GetDatabase(ntsServer, ntsMailFile)
Set oDoc = oDB.CreateDocument
' Définit les éléments à rajouter au message
Set oItem = oDoc.createRichTextItem("BODY")
oDoc.Form = "Memo"
' Préparer les destinataires
oDoc.Sendto = EMailSendTo
If Not IsMissing(EMailCopyTo) Then
oDoc.Copyto = EMailCopyTo
End If
' Préparer le sujet du message
If Not IsMissing(EMailSubject) Then
If EMailSubject <> "" Then oDoc.Subject = EMailSubject
End If
oDoc.FROM = oSess.CommonUserName
oDoc.PostedDate = Date
' Pour avoir un accusé de réception
oDoc.ReturnReceipt = "1"
' Préparer les texte
With oItem
.AppendText "TABLEAU DE SUIVI DES CONVOCATIONS CLIENTS AFFAIRE H2"
.AddNewline 1
.AppendText "*********************************************************************************"
.AddNewline 2
.AppendText "Des convocations clients ont été ajoutées pour l'affaire" & Cells(1, 1)
.AddNewline 1
.AppendText "N'oubliez pas de remplir les dates de convocations sur cette affaire"
.AddNewline 2
.AppendText "rendez-vous dans le répertoire ci-dessous pour consulter les convocations"
.AddNewline 2
.AppendText "Tableau des convocations clients"
.AddNewline 1
.AppendText "--------------------------------------------------------------------------------------------------------"
.AddNewline 2
.AppendText "Cellule Vert: Date de lancement de convocation compris entre -10 et -5 jours "
.AddNewline 1
.AppendText "Cellule Jaune: Date de lancement de convocation compris entre -5 et -1 jours"
.AddNewline 1
.AppendText "Cellule Rouge: Date de lancement de convocation compris entre -1 et +2 jours"
.AddNewline 2
.AppendText "Cet e-mail a été généré par un processus automatique."
.AddNewline 2
End With
' Créer la pièce jointe
' Ca peut être le classeur
WbkName = ThisWorkbook.FullName
'Attachement du classeur au mail
Call oItem.embedObject(1454, "", WbkName, "")
' Ou Attachement d'un document
'Call oItem.embedObject(1454, "", "Chemin et nom complet du doc","")
' Message de salutation
oItem.AddNewline 1
oItem.AppendText "Cordialement"
oItem.AddNewline 2
oItem.AppendText "Asim OZEL"
' Envoyer le message
oDoc.send False
'
MsgBox "Le message a été envoyé", vbInformation, "MESSAGE LOTUS ..."
exit_SendNotesMsg:
On Error Resume Next
Set oSess = Nothing
Set oDB = Nothing
Set oDoc = Nothing
Set oItem = Nothing
Exit Sub
err_SendNotesMsg:
If Err.Number = 7225 Then
MsgBox "Impossible d'attacher le fichier, vérifier le chemin!", vbCritical
Else
MsgBox "[" & Err.Number & "]: " & Err.Description
End If
MsgBox "Message non envoyé suite erreur!", vbCritical
Resume exit_SendNotesMsg
'
End Sub
