Discussion :

[graphikris]

Bonjour,

Je viens de lire une discussion concernant : Envoi d'une alerte sur boite mail outlook en cas de dépassement de délais

Mais celle ci ne correspond pas exactement a ce que je voudrais faire.

Moi je dois envoyer par mail vers outlook 2003, les memes infos mais mon classeur comporte plus de 500 personnes et je n'ai pas de cellule avec la date du jour.

Donc cette macro doit d'abord scanner la colonne incriminée et si une ou plusieurs dates sont dépassées alors un mail doit etre envoyé aux personnes concernés, les adresses mails se situent en colonne L et les dates en colonne P.
Je ne dois envoyer qu'un seul mail groupé vers tous les noms dont la date a ete dépasseé.

Je dois également envoyer un mail, X jours avant d'arriver à la date dépassée, comment dois je faire ?

Cordialement.

La reponse de Daniel C etait (A1)=date du jour et A3=date [28/02/2013] :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Alertes()
    Dim OlApp As Object, M As Object, C As Range
    With Sheets("Feuil1")
        If .[A3] > .[A1] Then
            Set OlApp = CreateObject("Outlook.Application")
            Set M = OlApp.CreateItem(olMailItem)
            M.Subject = "attention, le délais de réponse a été dépassé."
            M.Body = .[A1].Text & vbCrLf & vbCrLf & .[A3].Text
            M.Recipients.Add .[D3]
            M.Display
            'M.Send
        End If
    End With
End Sub

puis :

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
Sub Alertes()
Set wbk = GetObject("C:\Users\Daniel\Documents\Donnees\Daniel\mpfe\yannick59190 Nouveau Feuille de calcul Microsoft Excel.xls")
Set sh = wbk.Sheets("Feuil1")
Dim OlApp As Object, M As Object, C As Range
With sh
    If .[A3] > .[A1] Then
        Set OlApp = CreateObject("Outlook.Application")
        Set M = OlApp.CreateItem(olMailItem)
        M.Subject = "attention, le délais de réponse a été dépassé."
        M.Body = .[A1].Text & vbCrLf & vbCrLf & .[A3].Text
        M.Recipients.Add .[D3]
        M.Send
    End If
End With
wbk.Close False
End Sub

[graphikris]

Je suis vraiment dans la panade . En effet, la macro proposée par Daniel, fonctionne bien mais pas dans mon cas.
J'ai essayé de transformer le code avec d'autres modules trouvés sur le net mais çà ne fonctionne pas.

Y aurait il une âme charitable qui voudrait bien se pencher sur mon problème car sans cette macro, je suis obligé de faire des copier coller des adresses mails des personnes concernées et celà me prend des heures et des heures tous les mois.

[MarcelG]

Bonsoir,

A mon sens, le plus rigoureux serait d'alimenter une variable Tableau par les membres et dates concernés, puis de l'utiliser afin de créer un fichier Excel.
L'alimentation de ta variable s'effectuerait ainsi sous la condition que la date soit dépassée.
Le fichier Excel serait enregistré sous un nom et dans une ressource (répertoire) bien définis.
Ton mail auarait un corps de texte stndard;
Si tu souhaites un mail groupé, alors la liste de destinataires concernés alimenterait en boucle ta méthode add.
Autrement dit, tu ajoutes une par une l'adresse mail concernée à la liste des destinataires.
Le mail comprendrait alors en pièce jointe le fichier créé plus haut puis serait adressé.

[graphikris]

Merci pour votre réponse mais n’étant pas un expert du VBA, je ne comprends absolument pas votre réponse.
Je joins un exemple de ma BdD (les personnes dont la date apparait en rouge doivent recevoir un mail groupé).

Merci

[MarcelG]

Salut,

Aucun problème.

Pas à pas.

Si, par exemple, ton fichier présente 3 colonnes, dont la dernière comprend les dates que tu veux tester, alors...
La solution est de considérer toutes les données dates de cette colonne.
Pour toutes celles dépassées, une variable Tableau serait alimentées par toutes les données (autrement dit toutes les colonnes) correspondant à cette date.
Ensuite, cette variable Tableau alimenterait un classeur qui sera enregistré.

Si le fichier initial comprend 7 enregistrements (7 lignes) et 3 colonnes (dont celle de la date), le fichier final aurait toujours 3 colonnes mais les lignes extraites seront elles ayant une date dépassée.

Est-ce que c'est plus clair?

Je reviens avec une proposition de code.

[graphikris]

Yes,

En fait j'extrais dans un nouveau classeur toutes les dates dépassées avec les adresses mails correspondantes.

Je dois donc faire un msgbox avec par exemple date 1 puis date 2 (càd dates comprises entre date 1 et date 2), je fais un tri élaboré dans un nouveau classeur puis ??????

[MarcelG]

Salut,

Comme je te l'ai proposé,
C'est ce nouveau classeur qui figurera en pièce jointe à ton mail.

Voici déjà le code créant ce classeur depuis le classeur initial.
Nous verrons demain comment boucler sur les adresses mail qui y figurent pour alimenter les destinataires de ton mail groupé.
(Nota : l'adresse mail figure dans le classeur final, par exemple en colonne 1)

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
47
48
49
50
51
52
Public Sub essai_mail()
 
Dim n As Byte
Dim c As Range
Dim Tablo()
Dim derncel As Range
Dim nblign As Integer, nbcol As Integer
Dim leclasseur As Workbook
 
'O enregistrement au départ
n = 0
 
'Les dates figurent en colonne C
'Il y a 7 lignes à tester
 
For Each c In ThisWorkbook.Sheets(1).Range("C2:C7")
        With c
                'Test : date est inférieure à maintenant
                If .Value < Now Then
                        'Si oui, alors un enregistrement de plus à garder pour le fichier final
                        n = n + 1
                        'On redimensionne la 2ème dimension du tableau pour ajouter un enregistrement
                        'Les enregistrements vont s'ajouter en colonnes, c'est à dire de gauche à droite
                        ReDim Preserve Tablo(1 To 3, 1 To n)
                        'On alimente les 3 données correspondantes, dont la date
                        For i = 1 To 3
                                Tablo(i, n) = .Offset(0, i - 3)
                        Next i
                End If
        End With
Next c
 
'Nombre de colonnes
nbcol = UBound(Tablo, 1)
'Nombre de lignes
nblign = UBound(Tablo, 2)
 
'Alimentation de la feuille 2 en transposant les colonnes avec les lignes
With ThisWorkbook.Sheets(2)
        Set derncell = .Range("A1").Offset(nblign - 1, nbcol - 1)
        .Range(.Range("A1"), derncell).Value = WorksheetFunction.Transpose(Tablo)
        .Copy
End With
 
Set derncell = Nothing
 
Set leclasseur = ActiveWorkbook
leclasseur.SaveAs Filename:="Lechemincompletdu classeur+lenomduclasseur+extension.xls"
 
'leclasseur figurera en pièce jointe dans le mail
 
End Sub

[graphikris]

Merci Marcel,

Je te remercie pour ce code, j'attend avec impatience le reste de ta reponse.

Cordialement Chris

[MarcelG]

Bonjour Graphikris, Bonjour le Forum,

Voici! Voilou!

Pour plus de clarté, j'ai décomposé le code en 2 parties dans le même module
- Etablissement du classeur (future pièce jointe)
- Envoi du Mail

Pour ce faire, 2 variables auront une portés Module.
Donc à placer en entête de module

Code :

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

1
2
Dim leclasseur As String
Dim L_dest As String

En ce qui concerne la création du classeur, j'ai préféré conserver le nom complet (fullname) du classeur en termes de variable afin de l'utiliser
- dans son enregistrement
- comme référence de la pièce jointe au mail

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Public Sub essai_mail()
 
Dim Tablo()
Dim n As Byte
Dim c As Range
Dim derncel As Range
Dim nblign As Integer, nbcol As Integer
 
'O enregistrement au départ
n = 0
 
'Les dates figurent en colonne C
'Il y a 7 lignes à tester
 
For Each c In ThisWorkbook.Sheets(1).Range("C2:C7")
        With c
                'Test : date est inférieure à maintenant
                If .Value < Now Then
                        'Si oui, alors un enregistrement de plus à garder pour le fichier final
                        n = n + 1
                        'On redimensionne la 2ème dimension du tableau pour ajouter un enregistrement
                        'Les enregistrements vont s'ajouter en colonnes, c'est à dire de gauche à droite
                        ReDim Preserve Tablo(1 To 3, 1 To n)
                        'On alimente les 3 données correspondantes, dont la date
                        For i = 1 To 3
                                Tablo(i, n) = .Offset(0, i - 3)
                        Next i
                End If
        End With
Next c
 
'Nombre de colonnes
nbcol = UBound(Tablo, 1)
'Nombre de lignes
nblign = UBound(Tablo, 2)
 
'Alimentation de la feuille 2 en transposant les colonnes avec les lignes
With ThisWorkbook.Sheets(2)
        Set derncell = .Range("A1").Offset(nblign - 1, nbcol - 1)
        .Range(.Range("A1"), derncell).Value = WorksheetFunction.Transpose(Tablo)
        'Création du nouveau classeur à partir de la feuille de destination (n°2)
        'comportant tous les enregistrements à date dépassée
        'et qui sera joint au mail global
        .Copy
End With
 
Set derncell = Nothing
 
leclasseur = "lechemincomplet du classeur.xls"
With ActiveWorkbook
.SaveAs Filename:=leclasseur
.Close
End With
 
'--------- Destinataires ---------
 
L_dest = ""
'Alimentation de la liste des destinataires
For i = 1 To UBound(Tablo, 2)
        'Les adresses mail figurent dans la 1ère colonne
        'Donc le premier indice de la vaiable Tablo est 1
        L_dest = L_dest & Tablo(1, i) & ";"
Next i
'Contrôle
Debug.Print L_dest
 
'On vide le tableau
Erase Tablo
 
Call Envoi_Mail
 
End Sub

Quant au mail, ne pas oublier d'activer la référence

Code :

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

Microsoft Outlook 14 Object Library

La procédure est appelée dans la précédente

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
Sub Envoi_Mail()
 
 
'--------- Objet du Mail ---------
 
Objet_Mail = "Retard pris dans l'activité"
 
'--------- Corps de Texte ---------
 
Corps_Mail = "Vous avez pris du retard." & Chr(13) & "Voir le détail dans la pièce jointe."
 
' --------- Envoi Mail ---------
 
'Requiert une référence à la bibliothèque d'objets Outlook
Dim Applic_Outlook As Outlook.Application
Dim MonItem As Outlook.MailItem
 
'Crée l'objet Outlook
Set Applic_Outlook = New Outlook.Application
 
'Envoi du Mail à tous les destinataires
Set MonItem = Applic_Outlook.CreateItem(olMailItem)
With MonItem
        'Liste de diffusion définie ci-dessus
        .To = L_dest
        'Objet du Mail défini ci-dessus
        .Subject = Objet_Mail
        'La pièce jointe est celle créée dans la procédure précédente
        .Attachments.Add leclasseur
        .Display
        Application.Wait (Now + TimeValue("0:00:01"))
        'Corps du mail défini ci-dessus
        .Body = Corps_Mail
        'Par prudence
        Application.Wait (Now + TimeValue("0:00:01"))
        'Envoi du mail
        .Send
End With
 
Set Applic_Outlook = Nothing
 
End Sub

Il y a des détails à régler (en-têtes de colonnes du fichier joint, définition automatique de la colonne de référence (ici "C2:C7"),....).

Mais voilà l'esprit.

[graphikris]

Un énorme merci à toi Marcel

Grace a toi et ce forum, je vais pouvoir gagner énormément de temps.

Actuellement je suis en stage, mais dès mon retour au boulot, je teste ton code qui me rendra un grand service et surtout un gain de temps.

Encore Merci