Bonjour,

J'ai besoin de tester un fichier excel 1 fois par jour pour savoir si il contient des dates arrivèes à échéance.
Si c'est le cas je veux envoyer un e-mail à un ou plusieurs utilisateurs.
Pour lancer le teste systématiquement tous les matins, j'ai pensé utiliser l'ouverture de outlook car l'utilisateur s'en sert tous les jours.
A l'ouverture de Outlook une macro ouvre le fichier excel contenant les dates, puis il lance une macro dans excel qui teste les dates et envoi un e-mail. Enfin la macro Outlook ferme le fichier excel.


Mon problème.

Quand je lance la macro sous Excel pas de soucis, le mail est envoyé même si Outlook n'est pas ouvert.
Quand je lance ma macro dans Outlook "manuellement" (bouton macro => Exécuter ) pas de soucis

Par contre, quand la macro s’exécute toute seul à l'ouverture de Outlook ça provoque une erreur. Voir le code ligne
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Set OutApp = CreateObject("Outlook.Application")
J'ai essayé en temporisant le lancement mais même constat.
J'en conclu qu'il n'est peut être pas possible d'envoyer un e-mail alors même que Outlook est en phase d'ouverture.

Avez-vous une idée? Soit pour éviter le bug, soit pour lancer mon teste d'une autre façon...

Voici mon code dans Outlook

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
Private Sub Application_Startup()
 
 
 
'Application.Wait (Now + TimeValue("0:00:10"))
 
Dim s As Date
Dim t As Date
    'Tempo 10 secondes
    t = Timer + 10: Do Until Timer > t: DoEvents: Loop
 
Dim XlApp, XlClas
    Set XlApp = CreateObject("Excel.Application")
    Set XlClas = XlApp.Workbooks.Open("C:\Users\WALTER_SIMEONI\Desktop\Trouve date V4.xlsm")
   ' XlClas.Worksheets("Feuil1").Range("A6").Value = "toto"    'test écrir toto
    XlApp.Run "'" & XlClas.Name & "'!" & "test_date"
 
 
'    s = Timer + 5: Do Until Timer > s: DoEvents: Loop
 
   XlClas.Close True    'on ferme le classeur
    XlApp.Quit    'On quitte Excel
    'On libère la mémoire des variables
    Set XlClas = Nothing
    Set XlApp = Nothing
 
 
 
 
End Sub

Voici mon code dans Excel

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
ub test_date()
 
 
 
 
Dim T_date
T_date = Date
Dim Rep As Integer
Dim Delai As Integer
Dim DernLigne As Long
Dim Cnt As Long
Dim plage As Range
Dim Message As String
Dim Sujet As String
 
 
Dim dateProche As Date
DernLigne = Range("F1048576").End(xlUp).Row
 
Dim I As Integer, prec As String
Delai = 1095 'en nombre de jours; 3 ans = 1095j
 
Cnt = 0
Set plage = Worksheets("feuil1").Range("F1: F65000 ")
plage.Interior.ColorIndex = xlNone
 
 
 
 
 
 
  For I = 1 To DernLigne
    If Range("F1").Offset(I).Value <> "" Then
         If T_date - Delai > Range("F1").Offset(I).Value Then
        ' Range("F1").Offset(I).Interior.ColorIndex = 45
         Cnt = Cnt + 1
         ' I = I + 1
        End If
 
    End If
  Next I
 
 
 
 
   dateProche = Application.WorksheetFunction.Min(plage)
 
 
 
  If Cnt = 0 Then
 
 
    Dim OutApp As Object
    Dim OutMail As Object
 
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    'corps du message si besoin
 
    With OutMail
        .To = "simeoni@legras.fr"        'destinataire(s)
        '.CC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com"          ' copie
        '.BCC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com"       ' si BCC
        .Subject = "Pas de date a échéance"
        .Body = "Bonjour, il n'y a pas de délai dépassé aujourd'hui, la prochaine échéance sera " & dateProche & ", soit dans " & dateProche + Delai + 1 - T_date & " jours."
        'Piece_jointe
        '.Attachments.Add ("C:\test.txt")        'mettre chemin et fichier a joindre
        '.Display        'ouvre Outlook
        'or use
        .Send           'envoi sans ouvrir Outlook
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
 
 
 
 
 
  Else
 
 
    Set OutApp = CreateObject("Outlook.Application")    'Ca plante ici . Quand la macro est lancéé manuellement pas de soucis, mais quand elle est lancé à l'ouverture d'outlook ça plante. (mettre une tempo ne change rien)
    Set OutMail = OutApp.CreateItem(0)
    'corps du message si besoin
 
    With OutMail
        .To = "simeoni@legras.fr"        'destinataire(s)
        '.CC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com"          ' copie
        '.BCC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com"       ' si BCC
        .Subject = "ATTENTION délai"
        .Body = "Il y a " & Cnt & " dates arrivées à échéance aujourd'hui."
        'Piece_jointe
        '.Attachments.Add ("C:\test.txt")        'mettre chemin et fichier a joindre
        '.Display        'ouvre Outlook
        'or use
        .Send           'envoi sans ouvrir Outlook
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
 
 
 
 
  'MsgBox "Il y a " & Cnt & " dates arrivées à echéance"
 
'        For I = 1 To DernLigne
'            If Range("F1").Offset(I).Value <> "" Then
'                If T_date - Delai > Range("F1").Offset(I).Value Then
'                Range("F1").Offset(I).Select
'                I = I + 1
'                End If
'             End If
'    Next I
  End If
 
 
End Sub