Prb envoie pièce jointe

W

Windfly

Guest
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 \\\\SIMUfichier\\DAP\\Demandes'
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
 

Discussions similaires

Réponses
14
Affichages
699
Réponses
17
Affichages
1 K

Statistiques des forums

Discussions
312 493
Messages
2 088 944
Membres
103 989
dernier inscrit
jralonso