Problème envoi Lotus

[djstroubi]

Bonjour,

Je souhaites envoyer des mails via lotus à un certain nombre de destinataires. Tous le monde reçois les messages mais les mails envoyer aux non utilisateurs de Lotus ne contiennent ni corps de mail, ni pièce jointe alors que pour ceux qui utilisent lotus pas de soucis. J'ai recherché d'où cela pouvait provenir mail je sèche.
Voici mon code:

Sub envoyer()
'----------------------
On Error GoTo ErreurNET: Err.clear
Dim CheminEtFichier As String, NomDuFichier As String
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 Session As Object 'The notes session
Dim AttachME As Object 'Fich joint en RTF
Dim AttachF1 As Object '1' pièce attachée
Dim destinataire(8) As Variant
Dim myselection As Range

''---------------------- SOIT SAISIR LE FICHIER AVEC SON CHEMIN AVEC BOITE DE DIALOGUE
' CheminEtFichier = Application.GetOpenFilename("(*.*), *.*")
' If CheminEtFichier = "Faux" Then Exit Sub
'
'---------------------- SOIT SAISIR LE FICHIER EN DUR ICI ET LE CHEMIN SERA MIS AUTO
date2 = Format(Date, "ddmmyyyy")
Debug.Print date2
Date1 = Format(Date, "yyyymmdd")
For i = 3 To ThisWorkbook.Sheets.Count
If IsEmpty(ThisWorkbook.Sheets(i).Range("B15")) Then
Else

NomDuFichier = Sheets(i).Name & "_" & Date1
CheminEtFichier = "C:\documents\" & date2 & "\" & NomDuFichier & ".pdf"
' ----------------------------------------------------------------------------------------




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 = "Confirmation" & NomDuFichier
MailDoc.body = "Bonjour," & vbCrLf & "Veuillez trouver ci joint votre confirmation n° " & NomDuFichier & "." & vbCrLf & "Cordialement"

Debug.Print Sheets(i).Range("H2")

'---------------------- pièce jointe
Set AttachME = MailDoc.CreateRichTextItem("Attachment")
Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier)
'----------------------

MailDoc.SAVEMESSAGEONSEND = True
Set myselection = Sheets(i).Range("H2:H6")
'Send the document
MailDoc.PostedDate = Now()
g = 0
For Each Cell In myselection
If IsEmpty(Cell) Then
Else
destinataire(g) = Cell.Value
g = g + 1
End If
Next


MailDoc.Sendto = destinataire
' MailDoc.Send 0

Erase destinataire
' Sheets(i).Range("H2").Value
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set AttachF1 = Nothing
Set Session = Nothing


'-------------------------
On Error GoTo 0: Err.clear
Application.ScreenUpdating = True
End If
Next
Exit Sub

ErreurNET: 'trit erreur
Msg$ = "Erreur " & Err.Source & " No " & Err.Number & vbLf & vbLf & Err.Description
T$ = "Envoi Mail: Erreur !?"
MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.clear
Application.ScreenUpdating = True
'-------------------------



End Sub

Merci d'avance pour vos remarques et votre aide

Dj stroubi