Accusé de reception Lotus

Snoop

XLDnaute Occasionnel
Bonjour tout le monde, le forum !!!

Je viens de récupéré le code suivant qui fonction trés bien pour l'envoie d'email (lotus) via Excel.

mais je n'arrive pas à trouver le moyen de lui mettre un accusé de reception.

Si quelqu'un à une idée MERCI d'Avance !!!:D

Ci dessous le code :


Sub SendMail()
Dim objNotesDocument As Object
Dim objNotesField As Object
Dim I As Long: I = 1
' ou Function SenMail()
On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
While Range("a" & I) <> ""
' Cas avec la plage
EMailSendTo = Range("a" & I) ' Required - Send to address
' Cas avec une seule adresse
' EMailSendTo = "sr@toto.fr ' Required - Send to address

EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Test mail" ' Optional
Emailfield = "t:\test\" & Range("b" & I) & ".txt"

''Establish Connection to Notes
Set objNotesSession = CreateObject("Notes.NotesSession")

''Establish Connection to Mail File
'' .GETDATABASE("SERVER", "FILE")
Set objNotesMailFile = objNotesSession.GETDATABASE("", "")

''Open Mail
objNotesMailFile.OPENMAIL

''Create New Memo
Set objNotesDocument = objNotesMailFile.CREATEDOCUMENT

''Create 'Subject Field'
Set objNotesField = objNotesDocument.AppendItemValue("Subject", EmailSubject)

''Create 'Send To' Field
Set objNotesField = objNotesDocument.AppendItemValue("SendTo", EMailSendTo)

''Create 'Copy To' Field
Set objNotesField = _
objNotesDocument.AppendItemValue("CopyTo", EMailCCTo)

''Create 'Blind Copy To' Field
Set objNotesField = _
objNotesDocument.AppendItemValue("BlindCopyTo", EMailBCCTo)

''Create 'Body' of memo
Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")

With objNotesField
.APPENDTEXT "Cet e-mail a été généré par un processus automatique."
.ADDNEWLINE 1
.APPENDTEXT "This e-mail is generated by an automated process."
'.APPENDTEXT "Please follow established contact " & _
"procedures should you have any questions."
.ADDNEWLINE 2
.APPENDTEXT "Cordialement"
.ADDNEWLINE 1
.APPENDTEXT "DF"
End With

''Attach the file --1454 indicate a file attachment
'objNotesField = _
'objNotesField.EMBEDOBJECT(1454, "", ActiveWorkbook.FullName)

objNotesField = _
objNotesField.EMBEDOBJECT(1454, "", Emailfield)





''Send the e-mail
objNotesDocument.SEND (0)

''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing

''Set return code
'SendMail = True
'Exit Function

SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
'SendMail = False
I = I + 1
Wend
End Sub 'Function
 

RENAUDER

Nous a quitté
Repose en paix
Re : Accusé de reception Lotus

Bonjour,
Comme je n'ai pas testé, je voulais savoir si ton code nécessitait que Lotus soit ouvert car pour ton info, j'utilise à ce jour une fonction d'envoi de mails qui permet de les envoyer avec Lotus fermé.
le mot de passe est dans le code.
Toutefois comme toi, je n'ai pas trouvé pour l'AR alors je suis ton fil de près.
 

Snoop

XLDnaute Occasionnel
Re : Accusé de reception Lotus

Bonjour,

Il faut le lotus ouvert (car il va etre utiliser par d'autre personne).

Mais je suis intéresse quand même par envoyer sans ouvrir lotus.

De plus je voulais savoir comment lui indiquer le dossier ou sont les fichiers à envoyer.

Merci
 

RENAUDER

Nous a quitté
Repose en paix
Re : Accusé de reception Lotus

Bonjour,

Il faut cocher la référence Lotus Domino Objects


Code:
Sub EnvoiMail()
    Dim EMailPJ As String
    Dim Email(1) As String
    'Chemin = ActiveWorkbook.path & "\Report SAV Batch"
    ' Responsables
    Email(1) = "[EMAIL="erenaud@deutsch.net"]erenaud@deutsch.net[/EMAIL]"
    ' Boucle pour envoyer les mails
    For Z = 1 To 1
        EnvoiRef = prvSendNotesMail("Sujet du mail", "", Email(Z), SaveIt:=False)
    Next Z
End Sub
Function prvSendNotesMail(Subject As String, Attachment As String, Recipient As String, SaveIt As Boolean) As Boolean
    '*********************************************
    'Repris et développé par EvilGost
    ' Adapté par Eric RENAUD
    'Subject: Sujet du mail
    'Attachment: Chemin complet du fichier à attacher (ex: "C:\test.txt"), sinon, mettre ""
    'Recipient: Destinataire (ex: "[EMAIL="jeanlouis@wanadoo.fr"]jeanlouis@wanadoo.fr[/EMAIL]")
    'Bodytext: Texte du mail
    'SaveIt: sauvegarde du mail dans les courriers envoyés
    '*************************************************************************************************************
    'Set up the objects required for Automation into lotus notes
    Dim Maildb As NotesDatabase    'The mail database
    Dim UserName As String    'The current users notes name
    Dim MailDoc As Object    'The mail document itself
    Dim AttachME As Object    'The attachment richtextfile object
    Dim oSession As NotesSession
    Dim dbDirectory As NotesDbDirectory
    Dim EmbedObj As Object    'The embedded object (Attachment)
    Dim maDate As String
    maDate = Format(Date, "dd-mm-yy")
    Dim objNotesField As Object
    On Error GoTo ErrHandle
    Set oSession = New NotesSession
    'Démarre une session de notes
    'La ligne suivante ne marche qu'avec les versions 5.x et 6.x , c'est l'injection du mot de passe
    oSession.Initialize ("password")
    'Récupère le nom par défaut de la session
    UserName = oSession.UserName
    'Ouvre la base mail en utilisant le serveur par défaut
    Set dbDirectory = oSession.GetDbDirectory("EVREUX01/DEUTSCH")    'vous pouvez mettre l'adresse du serveur dans ces parentheses
    Set Maildb = dbDirectory.OpenMailDatabase
    'Création du formulaire d'envoi de mail
    Set MailDoc = Maildb.CreateDocument()
    MailDoc.AppendItemValue "Subject", Subject    'remplissage du Sujet
    MailDoc.AppendItemValue "SendTo", Recipient    'si vous passer un tableau de string() en paramètre, vous pouvez mettre plusieurs destinataire (ex: Recipient(2))
    Set objNotesField = MailDoc.CreateRichTextItem("Body")
    With objNotesField
        .AppendText "   Fichier ETAT DES STOCKS TOUS NIVEAUX POUR AIRBUS"
        .AddNewLine 2
        .AppendText "       avec l'ajout de la colonne Composants N-1"
        .AddNewLine 2
        .AppendText "*************************************************************************************************"
        .AddNewLine 2
        .AppendText "Le fichier Etat des stocks tous niveaux pour AIRBUS du : " & Date & " à " & Time
        .AddNewLine 2
        .AppendText "est enregistré sous le nom AQZZZ_IN_REP_Z_MM_17-01-XX-XX-XX.xls"
        .AddNewLine 2
        .AppendText "est disponible dans le répertoire V:\TRANSFER\FEDERICO\Z_MM_17-01\....."
        .AddNewLine 2
        .AppendText "--------------------------------------------------------------------------------------------------------------------------"
        .AddNewLine 2
        .AppendText "Cet e-mail a été généré par un processus automatique."
        '.APPENDTEXT "Please follow established contact " & _
         "procedures should you have any questions."
        .AddNewLine 2
        .AppendText "Cordialement"
        .AddNewLine 1
        .AppendText "Eric RENAUD"
        .AddNewLine 1
        .AddNewLine 1
    End With
    'Permet d'attacher un document au mail
    If Attachment <> "" Then
        Set AttachME = MailDoc.CreateRichTextItem("Attachment")
        Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")
    End If
    'Envoi le document
    If SaveIt = True Then
        MailDoc.SaveMessageOnSend = SaveIt    'si à True, Lotus sauvegarde le mail envoyé
    End If
    Call MailDoc.Send(False)    'j'obtiens une erreur lorsque je mets true au lieu de false, si quelqu'un sait pourquoi
    prvSendNotesMail = True
    GoTo ExitHandle
ErrHandle:
    MsgBox Err.Description
    prvSendNotesMail = False
ExitHandle:
    'Vidage mémoire
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set oSession = Nothing
    Set dbDirectory = Nothing
    Set EmbedObj = Nothing
End Function
 

Snoop

XLDnaute Occasionnel
Re : Accusé de reception Lotus

Bonjour,

je viens de trouver l'accusé de reception (suffit de regarder la propriété du document - mail lotus !!)

---->

objNotesDocument.ReturnReceipt = "0" ' "1" pour A/R et "0" sans A/R


objNotesDocument.Replyto = "" ' Pour que la personne reponde à ex "toto@toto.fr"


Mais il me reste encore une question, je voudrais que dans le corp du texte (body)
je puisse mettre du Gras ou Italique sur certaine partie, si une personne à une idée...

Merci
 

Discussions similaires

Statistiques des forums

Discussions
312 428
Messages
2 088 333
Membres
103 819
dernier inscrit
vinz_kid