Envoie d'un mail tous les mois

X

xyvyos

XLDnaute Junior
Bonjour,

J'aimerai créer une macro qui permet d'envoyer un mail (à 3 personnes si possible) contenant simplement le fichier excel en pièce jointe ou en lien hypertexte. Ce mail devra être envoyé tous les debuts de mois (vers le 1 ou le 2 par exemple). Mais je n'y arrive pas ...

Ce fichier concerne la maintenance préventive de chariots. Elle doit se réaliser tous les 6 mois. Ce mail permettra de "rafraichir" la mémoire des techniciens en voyant quelles maintenances n'ont pas été réalisées le mois précédent.

Je vous remercie d'avance pour votre aide.
 

Pièces jointes

  • Planning maintenancebis2.xlsm
    83.8 KB · Affichages: 32
  • Planning maintenancebis2.xlsm
    83.8 KB · Affichages: 30
Trier par date Trier par votes
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Envoie d'un mail tous les mois

Re,

Bizarre. Pourtant le Next il y est.

On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage

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

Pour le range("Adresses"), ça doit être une plage ou une cellule nommée.


A+ :cool:
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Envoie d'un mail tous les mois

Essayez celui-ci touvé sur comment ça marche.


Code: 
Private Sub UseLotus()

    Dim Session As Object
    Dim db As Object
    Dim doc As Object
    Dim rtitem As Object
    Dim object As Object
    Dim fs As Object
    Dim Principaux(2) As String
    Dim Copies(3) As String
    Dim dir As Object
    Dim inti As Integer
    Dim passwd As String
     
    On Error GoTo TraiteErreur
    
    'Demande le password Lotus(Dans le cas ou la session necessite un passwd)
    passwd = InputBox("Entrer votre password Lotus:", "Password")
    
    ' Création de la session Notes
    Set Session = CreateObject("Lotus.NOTESSESSION")
    
    'Ouverture d'une session NOTES
    Call Session.Initialize(passwd)'si pas de passwd pas de parametre pour initialize

    Set dir = Session.GETDBDIRECTORY("FranceServer1/DCI/BME/Omnia Group")
    Set db = dir.OpenMailDatabase
    
    ' Création d'un document
    Set doc = db.CREATEDOCUMENT

    'affectation du type mail
    Call doc.APPENDITEMVALUE("Form", "Memo")

    Call doc.APPENDITEMVALUE("Sendto", "destinataire@vba.com")
    Call doc.APPENDITEMVALUE("subject", "sujet")
    doc.SAVEMESSAGEONSEND = saveit 'sauvegarde du mail à l envoi
    
    Set rtitem = doc.createRichTextItem("Body")
    
    
    Dim nom As string 
    nom = ThisWorkbook.FullName
    'Attachement du classeur au mail
    Set object = rtitem.embedObject(1454, "", nom,"")
    
    Call doc.Send(True)
    Set object = Nothing
    Set rtitem = Nothing
    Set doc = Nothing
    Set db = Nothing
    Set Session = Nothing
    Exit Sub

TraiteErreur:
    MsgBox "Erreur Critique durant l envoi .", vbCritical, "Error"
    Set object = Nothing
    Set rtitem = Nothing
    Set doc = Nothing
    Set db = Nothing
    Set Session = Nothing
    Set fs = Nothing

End Sub


'Conclusion :
'Si vous voulez envoyé plusieurs doc attaché c simple vous utiliser autant de fois qu il y a de doc à attacher cette fonction :

'Set object = rtitem.embedObject(1454, "", "chemin et nomcomplet du doc","")


A+ :cool:
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Envoie d'un mail tous les mois

Bonjour xyvyos,

Non pas besoin de l'activer vous même, puisque vus lui imposez une condition (tous les 30 ou 31 jours).

Copiez-Collez ceci dans ThisWorkBook => Open

Code: 
    Dim Session As Object
    Dim db As Object
    Dim doc As Object
    Dim rtitem As Object
    Dim object As Object
    Dim fs As Object
    Dim Principaux(2) As String
    Dim Copies(3) As String
    Dim dir As Object
    Dim inti As Integer
    Dim passwd As String
     

If Day(Date) > 1 Then: MsgBox "Le fichier à déjà été envoié", , "Excel-Downloads": Exit sub

If Day(Date) = 1 Then

    On Error GoTo TraiteErreur
   
    'Demande le password Lotus(Dans le cas ou la session necessite un passwd)
   passwd = InputBox("Entrer votre password Lotus:", "Password")
   
    ' Création de la session Notes
   Set Session = CreateObject("Lotus.NOTESSESSION")
   
    'Ouverture d'une session NOTES
   Call Session.Initialize(passwd)'si pas de passwd pas de parametre pour initialize

    Set dir = Session.GETDBDIRECTORY("FranceServer1/DCI/BME/Omnia Group")
    Set db = dir.OpenMailDatabase
   
    ' Création d'un document
   Set doc = db.CREATEDOCUMENT

    'affectation du type mail
   Call doc.APPENDITEMVALUE("Form", "Memo")

    Call doc.APPENDITEMVALUE("Sendto", "destinataire@vba.com")
    Call doc.APPENDITEMVALUE("subject", "sujet")
    doc.SAVEMESSAGEONSEND = saveit 'sauvegarde du mail à l envoi
   
    Set rtitem = doc.createRichTextItem("Body")
   
   
    Dim nom As string
    nom = ThisWorkbook.FullName
    'Attachement du classeur au mail
   Set object = rtitem.embedObject(1454, "", nom,"")
   
    Call doc.Send(True)
    Set object = Nothing
    Set rtitem = Nothing
    Set doc = Nothing
    Set db = Nothing
    Set Session = Nothing
    Exit Sub

TraiteErreur:
    MsgBox "Erreur Critique durant l envoi .", vbCritical, "Error"
    Set object = Nothing
    Set rtitem = Nothing
    Set doc = Nothing
    Set db = Nothing
    Set Session = Nothing
    Set fs = Nothing
end if
End Sub


'Conclusion :
'Si vous voulez envoyé plusieurs doc attaché c simple vous utiliser autant de fois qu il y a de doc à attacher cette fonction :

'Set object = rtitem.embedObject(1454, "", "chemin et nomcomplet du doc","")


A+ :cool:
 
Dernière édition:
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Envoie d'un mail tous les mois

Re,

voici un exemple pris sur le même site

Code: 
'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.Sendto = "la tu mets l'adresse mail de ton correspondant" '(laisse les "")
MailDoc.CopyTo = "l'adresse de la personne en copie" '(laisse les "")
MailDoc.Subject = "la tu mets le sujet" '(avec des "")
' Construction du corps du message
Set objNotesField = MailDoc.CreateRichTextItem("Body")
With objNotesField
.AppendText "Bonjour,"
.AddNewLine 2
.AppendText "Ci-joint la situation." 'tu peux rajouter des lignes
.AddNewLine 2
.AppendText "Cordialement"
.AddNewLine 1
.AppendText "Martin DUPONT"
.AddNewLine 3
End With
MailDoc.SaveMessageOnSend = SaveIt
'Set up the embedded object and attachment and attach it
Attachment1 = "la tu mets le chemin d'acces complet de ton fichier excel.xls"
Attachment2 = "idem 2e fichier"
Attachment3 = "idem 3e ficher"
If Attachment1 <> "" And Attachment2 <> "" And Attachment3 <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment1")
MailDoc.CREATERICHTEXTITEM (Attachment1)
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment2")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment2, "Attachment2")
MailDoc.CREATERICHTEXTITEM (Attachment2)
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment3")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment3, "Attachment3")
MailDoc.CREATERICHTEXTITEM (Attachment3)
End If

A+ :cool:
 
Dernière édition:
Vote positif 0 Vote négatif
X

xyvyos

XLDnaute Junior
Re : Envoie d'un mail tous les mois

Bonjour,

Est ce que le code peux ressembler à ça ?

Merci

Code: 
Sub SendNotesMail()

If Day(Date) > 5 Then: MsgBox "Le fichier à déjà été envoié", , "Excel-Downloads": Exit Sub

If Day(Date) = 5 Then

'Set up the objects required for Automation into lotus notes
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If

'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.Sendto = "la tu mets l'adresse mail de ton correspondant" '(laisse les "")
MailDoc.CopyTo = "l'adresse de la personne en copie" '(laisse les "")
MailDoc.Subject = "la tu mets le sujet" '(avec des "")
' Construction du corps du message
Set objNotesField = MailDoc.CreateRichTextItem("Body")
With objNotesField
.AppendText "Bonjour,"
.AddNewLine 2
.AppendText "Ci-joint la situation." 'tu peux réjouter des lignes
.AddNewLine 2
.AppendText "Cordialement"
.AddNewLine 1
.AppendText "Martin DUPONT"
.AddNewLine 3
End With
MailDoc.SaveMessageOnSend = SaveIt
'Set up the embedded object and attachment and attach it
Attachment1 = "la tu mets le chemin d'acces complet de ton fichier excel.xls"
Attachment2 = "idem 2e fichier"
Attachment3 = "idem 3e ficher"
If Attachment1 <> "" And Attachment2 <> "" And Attachment3 <> "" Then
Set AttachME = MailDoc.CreateRichTextItem("Attachment1")
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment1, "Attachment1")
MailDoc.CreateRichTextItem (Attachment1)
Set AttachME = MailDoc.CreateRichTextItem("Attachment2")
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment2, "Attachment2")
MailDoc.CreateRichTextItem (Attachment2)
Set AttachME = MailDoc.CreateRichTextItem("Attachment3")
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment3, "Attachment3")
MailDoc.CreateRichTextItem (Attachment3)
End If
'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
MailDoc.Send 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing

End If

End Sub
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Envoie d'un mail tous les mois

Bonjour xyvyos,

je ne voudrais surtout pas offenser les XLNAUTES et EXCEL-DOWNLOADS. Comme moi je n'utilise pas Lotus Notes et je ne connais pas vraiment la façon de le codé, essayez de demander de l'aide sur le lien que je vous ai proposé. Bonne chance.


Amicalement Lone-Wolf
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Envoie d'un mail tous les mois

Bonjour xyvyos,

Quand même !! :confused:

Pourquoi tu ne vas pas demander de l'aide là où les personnes seraient à même de t'aider???
Je t'ai mis le lien pourtant. Si personne ici n'utilise Lotus Notes, comment veux tu qu'on aide?
En installant le logiciel sur notre ordi??


A+ :cool:
 
Vote positif 0 Vote négatif

Discussions similaires

Z
  • Question
Microsoft 365 code VBA envoie de mail
Réponses
2
Affichages
744
kiki29
kiki29
S
  • Résolu(e)
Microsoft 365 Fusion de 2 macro VBA (selection envoi de mail + envoie de fichier PDF)
Réponses
6
Affichages
1 K
soNZOOO
S
B
  • Résolu(e)
XL 2016 Selectionner date la plus proche au supérieur de la date d'aujourd'hui
Réponses
5
Affichages
883
babacool22
B
T
  • Question
Microsoft 365 problème d'ouverture d'un seul fichier Excel
Réponses
5
Affichages
697
Tatines
T
J
  • Question
Excel -VBA : Envoie plusieurs partie du même tableau dans un corps mail en fonction de certaines conditions
Réponses
0
Affichages
1 K
JBIK
J
M
  • Résolu(e)
XL 2013 Copier un Userform d'un fichier Excel vers un autre avec en l'adaptant avec les nouvelles feuilles
Réponses
10
Affichages
2 K
metalbarzotti
M
O
  • Question
XL 2013 Formule d'un fichier Excel qui fait référence à une autre formule d'un autre fichier Excel dont l'intitulé change tous les mois en VBA
Réponses
7
Affichages
796
onyirimba
O
O
  • Question
Microsoft 365 Envoi mail Outlook si date dépassée
Réponses
3
Affichages
1 K
Estysh
E
C
  • Question
XL 2013 Insérer lien hypertexte cliquable dans mail envoyé par VBA
Réponses
0
Affichages
2 K
Claggan
C
D
  • Question
XL 2013 Comment améliorer les performances d'un fichier Excel qui se traîne lamentablement ?
Réponses
3
Affichages
864
Dicas
D

Membres actuellement en ligne

4 membres et 60 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

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