Prb envoie pièce jointe

Bonjour windFly,

Une procédure publiée ici par Éric Renault.

Je ne l'ai pas testée et je n'ai pas l'environnement pour le faire.

Si cela peut t'aider !


Salutations!

'--------------------------------------
' Envoyer un mail avec Lotus Notes (y compris avec pièce jointe)

Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object


Function SendMail()

On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage
EMailSendTo = Cell.Value ' Required - Send to address
' Cas avec une seule adresse
'EMailSendTo = "Client@Fournisseur" ' Required - Send to address

EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Envoi d'un document joint" ' Optional

''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 "Eric RENAUD"
End With

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

''Send the e-mail
objNotesDocument.SEND (0)
Next Cell
''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
End Function
'--------------------------------------






"Windfly" <Windfly@discussions.microsoft.com> a écrit dans le message de news: BF539F52-2E46-4D6B-A6EB-6A2B6C9F10CA@microsoft.com...
Bonjour à tous,

Dans une macro, je voudrais envoyer un message via Lotus Notes en y
attachant le fichier concerné.
Voici ma macro :

Sub Bouton8_QuandClic()

If (Range("C3:J3").Text = "" Or Range("C4:J4").Text = "" Or
Range("C7:J7").Text = "" Or Range("C8:J8").Text = "" Or Range("C9:J9").Text "") Then
Style = vbCritical
reponse = MsgBox("Toutes les données ne sont pas rentrées!", Style,
"INCOMPLET")
Else
envoi1
End If
Worksheets("Accueil").Range("B8").FormulaR1C1 = "OK"
Worksheets("Accueil").Range("B9").FormulaR1C1 = Now
If Range("B12").Text = "1" Then Worksheets("Dossier
complet").Range("D11").FormulaR1C1 = "Produit à ventes faibles"
If Range("B13").Text = "1" Then Worksheets("Dossier
complet").Range("D11").FormulaR1C1 = "Produit plus fabriqué (ex: produit de
négoce)"
If Range("B14").Text = "1" Then Worksheets("Dossier
complet").Range("D11").FormulaR1C1 = "Produit plus aux normes"
If Range("B15").Text = "1" Then Worksheets("Dossier
complet").Range("D11").FormulaR1C1 = "Changement de gamme de produit"
If Range("B16").Text = "1" Then Worksheets("Dossier
complet").Range("D11").FormulaR1C1 = Range("C17").Text
End Sub

Sub envoi1()
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Get Current user
strUserName = Session.UserName
'Open the mail database in notes
Set Maildb = Session.getdatabase("", "")
If Maildb.IsOpen = False Then 'Not already open for mail
Maildb.OpenMail
End If
'Create new memo
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.SendTo = "guillaume.coulon@simu.com"
MailDoc.CopyTo = "guillaume.coulon@simu.com"
MailDoc.Subject = "Une nouvelle DAP est arrivée"
MailDoc.Body = "Une nouvelle DAP, demandée par " & Range("c3") & ", est
disponible et prête à être complété sur le serveur SIMUfichierDAPDemandes"
MailDoc.SaveMessageOnSend = False
MailDoc.From = strUserName

'Send the memo
MailDoc.Send 0

'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
Exit Sub
EndToSend:
'Error message
strMsg = "Une erreur est survenue lors de l'envoie du mail!!" ' Message.
intStyle = vbOKOnly ' Buttons.
strTitle = "Erreur d'envoie" ' Title.
intResponse = MsgBox(strMsg, intStyle, strTitle)
End Sub

Pouvez vous me dire ce qui me manque dedans svp?

Merci d'avance

Salutations

Guillaume