Problème de "surenvoie" de mails d'excel sur lotus

Bonjour,
J'ai réalisé une macro qui permet d'envoyer un mail automatiquement si une ou plusieurs cellules sont inférieures à d'autres. Le souci c'est qu'au lieu d'envoyer qu'un seul mail, lotus en envoie plusieurs : le 1er avec le texte mais sans le "cordialement" et le "nom prénom" (je sais pas pour quoi) ainsi qu'avec l'objet attaché et puis plusieurs autres avec seulement l'objet attaché.
J'aimerai qu'il y ait qu'un seul mail avec tout le texte et l'objet. Si quelqu'un a une idée...

Voici mon code :


Private Sub Worksheet_Change(ByVal Target As Range)


Dim seuil As Integer
Dim seuil_M As Integer
Dim seuil_Q As Integer
Dim seui_U As Integer


seuil = Sheets("Suivi").Range("I2").Value
seuil_M = Sheets("Suivi").Range("M2").Value
seuil_Q = Sheets("Suivi").Range("Q2").Value
seuil_U = Sheets("Suivi").Range("U2").Value

For s = 5 To 9
If Range("I" & s).Value < seuil Or Range("M" & s).Value < seuil_M Or Range("Q" & s).Value < seuil_Q Or Range("U" & s).Value < seuil_U Then
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj As Object
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.Sendto = "***@***.fr"
MailDoc.CopyTo = "***@***.fr" '
MailDoc.Subject = "Valorisation du stock de palettes"
Set objNotesField = MailDoc.CreateRichTextItem("Body")
With objNotesField
.AppendText "Bonjour,"
.AddNewLine 2
If Range("I" & s).Value < seuil Then
.AppendText "attention recommander : " & Sheets("Approvisionnement").Range("J2").Value
.AddNewLine 2
End If
If Range("M" & s).Value < seuil_M Then
.AppendText "attention recommander : " & Sheets("Approvisionnement").Range("J3").Value
.AddNewLine 2
End If
If Range("Q" & s).Value < seuil_Q Then
.AppendText "attention recommander : " & Sheets("Approvisionnement").Range("J4").Value
.AddNewLine 2
End If
If Range("U" & s).Value < seuil_U Then
.AppendText "attention recommander : " & Sheets("Approvisionnement").Range("J5").Value
.AddNewLine 2
End If
.AppendText "Date du dernier inventaire : " & Sheets("Suivi").Range("F2").Value
.AddNewLine 2
.AppendText "Cordialement"
.AddNewLine 1
.AppendText "nom prénom"
.AddNewLine 3
End With
MailDoc.SaveMessageOnSend = SaveIt
Attachment1 = "***.xls"
If Attachment1 <> "" Then
Set AttachME = MailDoc.CreateRichTextItem("Attachment1")
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment1, "Attachment1")
MailDoc.CreateRichTextItem (Attachment1)
End If
MailDoc.PostedDate = Now()
MailDoc.Send 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End If
Next s

End Sub



End Sub