Prb envoie pièce jointe

  • Initiateur de la discussion Initiateur de la discussion Windfly
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
774
  • Question Question
Microsoft 365 VBA sur outlook
Réponses
14
Affichages
1 K
Réponses
17
Affichages
2 K
Réponses
2
Affichages
1 K
Retour