J'avais récupéré il y a quelques temps un script sur ce forum (par oguruma je crois ?) permettant de créer un bouton qui envoyait un mail d'accusé de réception customisable à l'expéditeur. (HandUpAck)
Je souhaiterai juste modifier 2 points mais je ne sais pas comment faire :
1) reprendre le corps du message , c'est cette ligne :
Call mailACK.addRTBody(currentDoc,"Body")
Mais sans les éventuelles pièces jointes.... car actuellement ca renvoie tout..
2) Dans l'objet, concaténer du texte + la reprise de l'objet du message ouvert à l'écran
exemple : "accusé de reception : objet du message depuis lequel je déclenche le bouton"
actuellement j'ai mailACK.subject=objet
et
objet="texte bla bla bla "
Merci d'avance à tout ceux qui pourront m'aider !
- Code : Tout sélectionner
Option Public
Public Class Mail
Private MailSession As NotesSession
Private MailDB As NotesDataBase
Private MailDoc As NotesDocument
Private RTBody As Variant
Private RS As Variant
Private ItemSendTo As NotesItem
Private ItemCopyTo As NotesItem
Private ItemBlindCopyTo As NotesItem
Public Sub new
Set MailSession=New NotesSession
Set MailDB = MailSession.CurrentDataBase
Set MailDoc=New NotesDocument(MailDB)
Set RTBody = MailDoc.CreateRichTextItem( "Body" )
Set RS=MailSession.CreateRichTextStyle
MailDoc.Form="Memo"
End Sub
Public Sub SetRecipients(SendTo As Variant, CopyTo As Variant, BlindCopyTo As Variant)
Set ItemSendTo = New NotesItem( MailDoc, "SendTo", SendTo )
Set ItemCopyTo = New NotesItem( MailDoc, "CopyTo", CopyTo )
Set ItemBlindCopyTo = New NotesItem( MailDoc, "CopyTo", BlindCopyTo )
End Sub
Public Property Set Subject As String
MailDoc.Subject=Subject
End Property
Public Property Set ReturnReceipt As Variant
MailDoc.ReturnReceipt=ReturnReceipt
End Property
Public Sub SetBody(Body As Variant)
If Isarray(Body) Then
Forall T In Body
Call RTBody.AppendText( T )
Call RTBody.AddNewLine(1)
End Forall
Else
Call RTBody.AppendText( Body )
Call RTBody.AddNewLine(1)
End If
End Sub
Public Sub addRTBody(docFrom As NotesDocument, fieldName As String)
Dim RT As Variant
Call RTBody.AddNewLine(1)
Set RT=docFrom.getFirstItem(fieldName)
Call RTBody.AppendRTItem(RT)
End Sub
Public Sub addLine(n As Integer)
Call RTBody.AddNewLine(n)
End Sub
Public Sub SetDocLink(Msg As String,DocLink As NotesDocument)
Call RTBody.AddNewLine(1)
Call RTBody.AppendText( Msg )
Call RTBody.AppendDocLink( DocLink, MailDoc.Subject(0))
End Sub
Public Sub SetDocLinkDB(Msg As String,DocLink As NotesDataBase)
Call RTBody.AddNewLine(1)
Call RTBody.AppendText( Msg )
Call RTBody.AppendDocLink( DocLink, MailDoc.Subject(0))
End Sub
Public Sub SetAttachement(F As Variant)
If Isarray(F) Then
Forall Attached In F
Call RTBody.EmbedObject( EMBED_ATTACHMENT, "", Attached)
End Forall
Else
Call RTBody.EmbedObject( EMBED_ATTACHMENT, "", F)
End If
End Sub
Public Property Set Principal As String
MailDoc.Principal=Principal
End Property
Public Property Set ReplyTo As String
MailDoc.ReplyTo=ReplyTo
End Property
Public Sub SetColor(Color As Variant)
RS.NotesColor=Color
Call RTBody.AppendStyle(RS)
End Sub
Public Sub SetBold(isBold As Integer)
RS.Bold=isBold
Call RTBody.AppendStyle(RS)
End Sub
Public Sub SetItalic(isItalic As Integer)
RS.Italic=isItalic
Call RTBody.AppendStyle(RS)
End Sub
Public Sub Send(isSave)
Call MailDoc.Send( isSave )
End Sub
Public Sub Delete
Set MailDoc=Nothing
Set MailSession=Nothing
Set MailDB=Nothing
Set RTBody=Nothing
Set RS=Nothing
End Sub
End Class
Sub Initialize
'// Agent chargé de créer un ACK manuel
Dim session As NotesSession
Dim currentDB As NotesDatabase
Dim currentDoc As NotesDocument
Dim collection As NotesDocumentCollection
Dim objet As String
Dim corpsMsg(5) As String
Dim nn As NotesName
'// utilisation de la classe Mail (voir la section (Declarations)
'// cette classe est personnelle et elle permet de créer simplement des message
Dim mailACK As Mail
On Error Goto handleError
'// Initialisation du message de réponse standard
objet="Accusé de réception : xxxxxx "
corpsMsg(0)="Bonjour, bien reçu merci."
corpsMsg(1)=" "
corpsMsg(2)=""
corpsMsg(3)=""
corpsMsg(4)="signataire"
corpsMsg(5)="signataire suite"
'// ces lignes sont à personnaliser
'// Session Lotus Notes
Set session=New NotesSession
Set currentDB = session.CurrentDataBase
'// On capte le(s) document(s) sélectionnés
Set collection=currentDB.UnprocessedDocuments
'// on traite les documents sélectionnés à travers la collection
Set currentDoc=collection.getFirstDocument
While Not (currentDoc Is Nothing)
Print "Réponse au message de ";currentDoc.From(0)
'// construction de l'ACK
Set mailACK=New Mail()
'// on renseigne le sujet
mailACK.subject=objet
'// on renseigne l'expéditeur et on empeche toute reponse
mailACK.Principal="truc@xx.fr"
mailACK.ReplyTo="nepasrepondre@xx.fr"
'// on envoie à l'émetteur
Call mailACK.SetRecipients(currentDoc.From(0),Null,Null)
'// Notre message en gras et bleu
Call mailACK.SetBold(True)
Call mailACK.SetColor(COLOR_BLUE)
'// on place le corps du message
Call mailACK.SetBody(corpsMsg)
'// on récupère le contenu du message reçu afin de le renvoyer à son émetteur
Call mailACK.addRTBody(currentDoc,"Body")
'// et enfin on envoie le message
Call mailACK.send(False)
Set nn=New NotesName(currentDoc.From(0))
Msgbox "Accusé réception bien envoyé à " & nn.Common,64
'// on regarde si un autre document est sélectionné
Set currentDoc=collection.getNextDocument(currentDoc)
Wend
Exit Sub
handleError:
Msgbox "Erreur N° " & Err & " - " & Error$,16,"Accusé réception"
Resume fin
fin:
End Sub
