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

[Jubei1]

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

 

[camarchepas]

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

Bonjour Jubei,

Utilise systématiquement en début de module : Option Explicit ' Cela oblige à déclarer les varialbles

car tu déclares : Dim seui_U As Integer , mais tu utilises seuil_U

Plus

Voilà , j'ai trouvé des lignes send doublées , mais j'ai plus Lotus donc pas pu tester.

Private Sub Worksheet_Change(ByVal Target As Range)


Dim seuil As Integer
Dim seuil_M As Integer
Dim seuil_Q As Integer
Dim seuil_U As Integer
Dim S As Long
Dim objNotesField As Object
Dim Attachment1 As String

seuil = "1" 'Sheets("Suivi").Range("I2").Value
seuil_M = "2" ' Sheets("Suivi").Range("M2").Value
seuil_Q = "3" 'Sheets("Suivi").Range("Q2").Value
seuil_U = "4" '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

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.SaveMessageOnSend SaveIt:=True
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End If
Next S

End Sub

 

[Jubei1]

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

Pour le moment j'ai contourner le problème donc le problème ne se pose plus. Mais merci quand même pour ta réponse je testerai dés que l'occasion se présentera !