Discussion :

[gio710]

C'est souvent un problème d'envoyer des mails aux clients en dehors des heures de travail car cela donne le sentiment d'une dispo H24 et une réponse immédiate dans certains cas génère un cercle vicieux de perte de temps à échanger sur des problèmes qui se seraient spontanément résolus.

Pour cette raison j'ai cherché du code de manière à m'aider à mieux gérer ce flux et ne pas alimenter l'illusion de la dispo h24 et du tout tout de suite.

Le code ci-dessous fonctionne à merveille pour autant qu'il soit stocké sous :
- Microsoft Outlook Objets\ThisOutlookSession
Nous vous nous vous nous vous nous vous nous vous nous vous nous vous nous vous nous vous
Le seul problème est qu'à chaque démarrage de session outlook j'ai une alerte de sécurité dont je veux me débarrasser, et je veux aussi que le code soit opérationnel automatiquement au démarrage sans passer par cette boite de dialogue. Merci pour vos idées pour éviter cela.

Voici le code, qui intéressera plusieurs d'entre vous

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
Dim obj As Object
Dim Mail As Outlook.MailItem
Dim WkDay As Integer
Dim MinNow As Integer
Dim SendHour As Integer
Dim SendDate As Date
Dim SendNow As String
Dim UserDeferOption As Integer
Function getActiveMessage() As Outlook.MailItem
Dim insp As Outlook.Inspector
If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
        Set insp = Application.ActiveWindow
    End If
If insp Is Nothing Then
        Dim inline As Object
        Set inline = Application.ActiveExplorer.ActiveInlineResponse
        If inline Is Nothing Then Exit Function
Set getActiveMessage = inline
    Else
       Set insp = Application.ActiveInspector
       If insp.CurrentItem.Class = olMail Then
          Set getActiveMessage = insp.CurrentItem
       Else
         Exit Function
       End If
End If
End Function
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'On Error GoTo ErrorHandler
'This sub used to delay the sending of an email from send time to the next work day at 8am.
'Set Variables
SendDate = Now()
SendHour = Hour(Now)
MinNow = Minute(Now)
WkDay = Weekday(Now)
'MsgBox ("On est le jour de la semaine No " & WkDay & " et il est " & SendHour & "h" & MinNow & "minutes")
SendNow = "O"
'Vérifier si on est avant 7h du matin
If SendHour < 7 Then
MsgBox ("Il est tôt pour envoyer un email : on est avant 7h")
SendHour = 8 - SendHour
SendDate = DateAdd("h", SendHour, SendDate)
SendDate = DateAdd("N", -MinNow, SendDate)
SendNow = "N"
End If
'Vérifier si on est après 7h du matin un autre jour qu ele vendredi
If SendHour >= 18 Then 'After 6 PM
SendHour = 32 - SendHour 'Envoi à 8h le lendemain
SendDate = DateAdd("h", SendHour, SendDate)
SendDate = DateAdd("N", -MinNow, SendDate)
SendNow = "N"
End If
'Vérifier si dimanche
If WkDay = 1 Then
SendDate = Now()
SendHour = Hour(Now)
SendDate = DateAdd("d", 1, SendDate)
SendDate = DateAdd("h", 8 - SendHour, SendDate)
SendDate = DateAdd("N", -MinNow, SendDate)
SendNow = "N"
End If
'Vérifier si samedi
If WkDay = 7 Then
SendDate = Now()
SendHour = Hour(Now)
SendDate = DateAdd("d", 2, SendDate)
SendDate = DateAdd("h", 8 - SendHour, SendDate)
SendDate = DateAdd("N", -MinNow, SendDate)
SendNow = "N"
End If
'Vérifier si vendredi après 18h
If WkDay = 6 And SendHour >= 18 Then 'Après vendredi 18h
SendDate = Now()
SendHour = Hour(Now)
SendDate = DateAdd("d", 3, SendDate)
SendDate = DateAdd("h", 8 - SendHour, SendDate)
SendDate = DateAdd("N", -MinNow, SendDate)
SendNow = "N"
End If
'Send the Email
Set obj = getActiveMessage()
If obj Is Nothing Then
'Ne rien faire - il y a probablement un problème de claendrier 'Do nothing - as this is likely a calendar issue
'MsgBox "Pas d'inspecteur actif"
Else
If TypeOf obj Is Outlook.MailItem Then
Set Mail = obj
'Vérifier auprès de l'utilisateur s'il veut reporter l'envoi du message à une plage ouvrée
If SendNow = "N" Then
UserDeferOption = MsgBox("Voulez-vous reporter cet envoi à un jour ouvré et aux heures de bureau, soit le (" & SendDate & ")?", vbYesNo + vbQuestion, "Vous envoyez un message en dehors des heures habituelles de travail !")
If UserDeferOption = vbYes Then
Mail.DeferredDeliveryTime = SendDate
'MsgBox ("Votre message sera envoyé le : " & SendDate)
Else
End If
End If
End If
End If
Exit Sub
'ErrorHandler:
' MsgBox "Erreur!"
End Sub

[Oliv-]

Bonjour,
il faut ajuster le niveau de sécurité.

Si l'onglet développeur est apparent, il suffit ce cliquer sur Développeur\Sécurité des macros
Sinon il faut passer par
Fichier/Options/Centre de gestion de la confidentialité/Paramètres du Centre de gestion de la confidentialité/Paramètre des macros

on coche la 4ème option

-Activer toutes les macros (non recommandé, exécution possible de code potentiellement dangereux)