Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

Sub SendNotesMail() 

On Error Resume Next 


    Dim Maildb As Object 'The mail database 
    Dim UserName As String 'The current users notes name 
    Dim MailDbName As String 'THe current users notes mail database name 
    Dim MailDoc As Object 'The mail document itself 
    Dim AttachME As Object 'The attachment richtextfile object 
    Dim Session As Object 'The notes session 
    Dim EmbedObj As Object 'The embedded object (Attachment) 
    
    Set Session = CreateObject("Notes.NotesSession") 
    UserName = Session.UserName 
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf" 
    'Open the mail database in notes 
    Set Maildb = Session.GetDatabase("", MailDbName) 
     If Maildb.IsOpen = True Then 
          'Already open for mail 
     Else 
      
     Maildb.OPENMAIL 
            
     End If 
    'Set up the new mail document 
    Set MailDoc = Maildb.CreateDocument 
    MailDoc.Form = "Memo" 
    MailDoc.Subject = "Envoi Automatique ......" 
    MailDoc.body = "message....."
    MailDoc.SAVEMESSAGEONSEND = saveit 
    
    
    'Send the document 
    MailDoc.PostedDate = Now()  
    MailDoc.Send 0, "306xshdi@xxxxxxx.fr" 
    'Clean Up 
    Set Maildb = Nothing 
    Set MailDoc = Nothing 
    Set AttachME = Nothing 
    Set Session = Nothing 
    Set EmbedObj = Nothing 
End Sub

Private Sub UseLotus() 
    Dim Session As Object 
    Dim db As Object 
    Dim doc As Object 
    Dim rtitem As Object 
    Dim object As Object 
    Dim fs As Object 
    Dim Principaux(2) As String 
    Dim Copies(3) As String 
    Dim dir As Object 
    Dim inti As Integer 
    Dim passwd As String 
      
    On Error GoTo TraiteErreur 
    
    'Demande le password Lotus
    passwd = ".....mot_de_passe_à_renseigner........" 
    
        
    ' Création de la session Notes 
    Set Session = CreateObject("Lotus.NOTESSESSION") 
    
    'Ouverture d'une session NOTES 
    Call Session.Initialize(passwd) 
    Set dir = Session.GetDbDirectory("......nom_du_serveur_à_renseigner.......") 
    Set db = dir.OpenMailDatabase 


    Set doc = db.CreateDocument 
    Call doc.AppendItemValue("Form", "Memo")
    Call doc.APPENDITEMVALUE("Sendto", "306xshdi@xxxxxxx.fr") 
    Call doc.AppendItemValue("subject", "Envoi Automatique.....") 
    Call doc.AppendItemValue("body", "Message....") 
    doc.SAVEMESSAGEONSEND = saveit 
  
        
    Call doc.Send(True) 
    Set object = Nothing 
    Set rtitem = Nothing 
    Set doc = Nothing 
    Set db = Nothing 
    Set Session = Nothing 
    Exit Sub 
TraiteErreur: 
    MsgBox "Erreur Critique durant l'envoi .", vbCritical, "Error" 
    Set object = Nothing 
    Set rtitem = Nothing 
    Set doc = Nothing 
    Set db = Nothing 
    Set Session = Nothing 
    Set fs = Nothing 
End Sub