Ajout fonction "envoi mail" à un macro deja existant
Bonjour à tous,
J'utilise au boulot un fichier partagé qui grâce à vous est très fonctionnel.
Vient aujourd'hui le temps de l'améliorer...
Actuellement: les utilisateurs peuvent entrer des donnée dans une page du fichier puis cliquer sur "ENREGISTRER" pour qu'une multitude de chose se fasse... (création nouvel onglet, ajout d'une case coloré sur un autre onglet "calendrier"...)
Bientôt:
l'idée serait juste d’ajouter à mon maccro déjà existant (je le copie dessous) la fonction pour que en plus de toutes ces actions déjà réalisées un mail soient envoyée à une liste de destinataires dont les adresses sont référencées dans un autre onglet.
oula simple à comprendre mais dur à expliquer
Si quelqu'un peut une nouvelle fois m'aider svp.
Merci d'avance
le maccro que j’utilise actuellement:
Sub Enregistrer()
Dim Ev(4), m%, i%, j%, n%, nf$, d As Date
Dim ws As Worksheet, wsm As Worksheet, wsca As Worksheet
Set wsm = Worksheets("ModelJour")
Set wsca = Worksheets("Calendrier ANNUEL")
With Worksheets("AJOUT EVENEMENTS")
For i = 0 To 4
Ev(i) = .Range("G" & i + 7)
Next i
m = Month(DateValue("1 " & .Cells(6, 12))) * 2 - 1
Application.ScreenUpdating = False
For j = 2 To 11
If .Cells(6, j) <> "" Then
nf = .Cells(6, j) & " " & .Cells(6, 12) & " " & .Cells(6, 13)
On Error GoTo NoFeuil
Set ws = Worksheets(nf)
On Error GoTo 0
n = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(n, 1).Resize(, 5).Value = Ev
Else
Exit For
End If
Next j
.Activate
End With
Exit Sub
NoFeuil:
wsm.Visible = True
wsm.Copy after:=Worksheets(Worksheets.Count)
Set ws = ActiveSheet
ws.Name = nf: ws.Range("B1") = nf
wsm.Visible = False
d = DateValue(nf)
With wsca.Columns(m)
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To n
If .Cells(i, 1) = d Then
.Cells(i, 2).Interior.Color = vbRed
Exit For
End If
Next i
End With
Resume Next
End Sub
Bonjour,
en effet ta macro est bien complète et difficile à dire ce qu'elle fait sans fichier.
Ci-dessous une macro permettant d'envoyer un mail :
Sub Envoyer_Mail_Outlook()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
'---------------------------------------------------------
With oBjMail
.To = "blabla@hotmail.fr 'le destinataire, tu peux mettre une Range ou un ensemble de Range tant que c'est sous la forme finale "adresse;adresse;adresse;..."
.Subject = "Titre" ' l'objet du mail
.Body = "Message" 'le corps du mail ..son contenu
'.Attachments.Add ActiveWorkbook.FullName 'si tu veux joindre le fichier
.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.Send
End With
Set oBjMail = Nothing
Set ObjOutlook = Nothing
End Sub
Je te conseille de laisser la macro tel quel, en ajoutant ta variable pour les destinataire et autres au sein du titre ou du corps du mail. Et d'appeler cette macro depuis ta macro principale avec :
Call Module1.Envoyer_Mail_Outlook
A plus !
Super,
Merci beaucoup, j'essaie ça de suite mais vu mon niveau lamentable j'ai là encore besoin de précisions:
-La première:
Dans le cas de ce macro, nous sommes d'accord que c'est bien au moment où la personne cliquera sur le bouton que j'ai créé "ENREGISTRER" que le mail sera envoyé?
-Il faut que je remplace:
"blabla@hotmail.fr 'le destinataire, tu peux mettre une Range ou un ensemble de Range tant que c'est sous la forme finale "adresse;adresse;adresse;..."
Par les adresses des destinataires?
-si je ne souhaite pas que le fichier soit envoyé via le mail, je supprime cette partie:
'.Attachments.Add ActiveWorkbook.FullName 'si tu veux joindre le fichier
.Display ' Ici on peut supprimer pour l'envoyer sans vérification
Dans ton maccro, c'est bien les seules choses que je dois modifier?
Merci beaucoup
Oui c'est ça,
pour le destinataire tu peux soit mettre dans la macro :
'Soit :
.To = "blabla@hotmail.fr;lololo@hotmail.fr;lililil@hotmail.fr"
'soit :
.To = Range("A1") & ";" & Range("A2") & ";" & Range("A3")
'soit :
.To = Range("A1") 'mais A1 doit être comme ceci sur ta feuille = "blabla@hotmail.fr;lololo@hotmail.fr;lililil@hotmail.fr" sans les guillemets
Ensuite juste la ligne ".Attachments.Add ActiveWorkbook.FullName 'si tu veux joindre le fichier" a supprimer.
La ligne display, tu peux essayer avec ou sans, c'est selon ce que tu preferes !