Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre à l'essai
    Homme Profil pro
    médecin
    Inscrit en
    juin 2018
    Messages
    14
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Suisse

    Informations professionnelles :
    Activité : médecin

    Informations forums :
    Inscription : juin 2018
    Messages : 14
    Points : 16
    Points
    16
    Par défaut macro outlook qui aide à gérer l'envoi des mails aux heures de bureau-code opérationnel au démarrage
    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

  2. #2
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    3 757
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 757
    Points : 6 554
    Points
    6 554
    Billets dans le blog
    17
    Par défaut
    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)

Discussions similaires

  1. Réponses: 5
    Dernier message: 03/07/2017, 11h27
  2. Réponses: 4
    Dernier message: 29/11/2015, 22h25
  3. Conception d'un logiciel qui envoie des mails
    Par kuroka dans le forum ALM
    Réponses: 0
    Dernier message: 01/05/2012, 04h10
  4. Macro Outlook qui lance une Macro Excel qui veut envoyer un mail = Bug
    Par Lameth dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 18/07/2008, 11h21
  5. Gérer l'envoi de mail préformaté avec outlook depuis données Excel
    Par drthodt dans le forum Macros et VBA Excel
    Réponses: 11
    Dernier message: 06/12/2007, 11h52

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo