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 !!!
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
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 !!!
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