Discussion :

[lindoushka]

Bonjour,

Je ne maitrise pas VBA mais je comprends comment cela fonctionne.
J'ai une base de données sous excel avec beaucoup de dates et je souhaiterais créer l'envoi d'un mail automatique contenant la date fixe et le sujet de rdv à cette date. L'envoi de ce mail se ferait 2 jours avant que la date ne soit atteinte.
De plus, suis-je obligée d'ouvrir tous les jours la BD pour que le mail s'envoie? Merci beaucoup!

J'ai déjà un bout de code qui marche, mais il ne m'envoie donc qu'un mail vide "Bonjour".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub EnvoiMail()
 Dim MonOutlook, MonMessage As Object
    Dim Corps As String
 
    Set MonOutlook = CreateObject("Outlook.Application")
    Set MonMessage = MonOutlook.createitem(0)
 
    MonMessage.to = "XXXXXX@XXXXXX.com"
 
    MonMessage.Subject = "DTL-Accessoires : " & Mid(ActiveWorkbook.Name, 1, 16)
 
    Corps = "Bonjour, Ne pas oublier la date importante :"
    MonMessage.body = Corps
 
    MonMessage.Send
 
    Set Raccourci = Nothing
    Set MonOutlook = Nothing
End Sub

[Mr Poulpe]

Bonjour,

Tu peux peut être essayer un truc qui ressemble à ça:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub dfdd()
Dim i As Long
Dim Cur_Cel As Range
Dim Diff_date As Long
'On suppose que la colonne k contient la date
'la colonne L sert à noter si un mail a été envoyé
'la colonne M contient le destinataire du mail
 
With Sheets("Feuil1")
    i = 2
    While .Cells(i, "k") <> ""
        Set Cur_Cel = .Cells(i, "k")
        Diff_date = DateDiff("d", Now, Cur_Cel)
        If Diff_date <= 2 And Diff_date >= 0 And .Cells(i, "L") <> "Rappel envoyé" Then
            Call EnvoiMail(.Cells(i, "M"), Cur_Cel.Value) 'on envoie le mail
            'IMPORTANT : On va éviter de spammer, donc il est important de ne pas envoyer deux fois un mail à la même personne
            'On marque les lignes déjà traitées avec un "Rappel envoyé"
            .Cells(i, "L") = "Rappel envoyé"
        End If
        i = i + 1
    Wend
End With
End Sub
Sub EnvoiMail(Destinataire As String, Date_rdv As Long)
 Dim MonOutlook, MonMessage As Object
    Dim Corps As String
 
    Set MonOutlook = CreateObject("Outlook.Application")
    Set MonMessage = MonOutlook.createitem(0)
 
    MonMessage.to = Destinataire
 
    MonMessage.Subject = "DTL-Accessoires : " & Mid(ActiveWorkbook.Name, 1, 16)
 
    Corps = "Bonjour," & vbCrLf _
    & "Ne pas oublier la date importante du " _
    & Day(Date_rdv) & "/" & Month(Date_rdv) & " à " & Hour(Date_rdv) & "h" & Minute(Date_rdv)
 
    MonMessage.body = Corps
    MonMessage.Send
    DoEvents
 
    Set Raccourci = Nothing
    Set MonOutlook = Nothing
End Sub

Poulpe

[lindoushka]

"l'indice n'apparait pas a la selection" apparait..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
Sub dfdd()
Dim i As Long
Dim Cur_Cel As Range
Dim Diff_date As Long
'On suppose que la colonne k contient la date
'la colonne L sert à noter si un mail a été envoyé
'la colonne M contient le destinataire du mail
 
With Sheets("Classeur1")
    i = 2
    While .Cells(i, "A") <> ""
        Set Cur_Cel = .Cells(i, "A")
        Diff_date = DateDiff("d", Now, Cur_Cel)
        If Diff_date <= 2 And Diff_date >= 0 And .Cells(i, "ok") <> "Rappel envoyé" Then
            Call EnvoiMail(.Cells(i, "linda.valero@eurocopter.com"), Cur_Cel.Value) 'on envoie le mail
            'IMPORTANT : On va éviter de spammer, donc il est important de ne pas envoyer deux fois un mail à la même personne
            'On marque les lignes déjà traitées avec un "Rappel envoyé"
            .Cells(i, "A") = "Rappel envoyé"
        End If
        i = i + 1
    Wend
End With
End Sub
Sub EnvoiMail(Destinataire As String, Date_rdv As Long)
 Dim MonOutlook, MonMessage As Object
    Dim Corps As String
 
    Set MonOutlook = CreateObject("Outlook.Application")
    Set MonMessage = MonOutlook.createitem(0)
 
    MonMessage.to = Destinataire
 
    MonMessage.Subject = "DTL-Accessoires : " & Mid(ActiveWorkbook.Name, 1, 16)
 
    Corps = "Bonjour," & vbCrLf _
    & "Ne pas oublier la date importante du " _
    & Day(Date_rdv) & "/" & Month(Date_rdv) & " à " & Hour(Date_rdv) & "h" & Minute(Date_rdv)
 
    MonMessage.body = Corps
    MonMessage.Send
    DoEvents
 
    Set Raccourci = Nothing
    Set MonOutlook = Nothing
End Sub

[Mr Poulpe]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With Sheets("Classeur1")

'Sheets' représente les feuilles du classeur, pas les classeurs eux-même. Je pense que 'classeur1' est le nom de ton classeur et non celui de ta feuille. Remplace ce classeur1 par le nom de la feuille avec les données.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Diff_date <= 2 And Diff_date >= 0 And .Cells(i, "ok") <> "Rappel envoyé" Then

Le "OK" ici sert à représenter la colonne dans laquelle on note si on a envoyé un rappel. Je ne pense pas que tu aies rempli ton tableau jusqu'à la colonne "OK", j'imagine qu'il s'agit plutôt de la colonne "A" comme à la ligne 19.

Par ailleurs, pense à enregistrer ton classeur après utilisation une fois ton projet terminé, pour enregistrer les lignes pour lesquelles un rappel a été envoyé.

Poulpe

[lindoushka]

Encore un pb avec "argument non facultatif" . Il me met en surbrillance le EnvoiMail

[Mr Poulpe]

En fait dans le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call EnvoiMail(.Cells(i, "xxx.xxx@xxx.com"), Cur_Cel.Value)

on cherche à récupérer la colonne.

Donc le xxx.xxx@xxx.com est à remplacer par la lettre de la colonne qui contient l'addresse mail de la personne à laquelle on souhaite envoyer ce mail, au sein de ta table.

Par exemple, .cells(i,"D") si l'addresse mail est contenue dans la colonne D.

Par contre, je crains de ne plus pouvoir faire de tests, n'ayant plus accès à outlook. J'espère que ça pourra déjà t'aider.

Poulpe