1. #1
    Nouveau Candidat au Club
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    février 2018
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 28
    Localisation : France, Isère (Rhône Alpes)

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux

    Informations forums :
    Inscription : février 2018
    Messages : 3
    Points : 1
    Points
    1

    Par défaut Modification Expediteur avec l'alias de reception

    Bonjour,

    Configuration actuelle :
    1 mail par defaut : toto@tutu.fr (et 2 groupe de distribution : tata@tutu.fr et tonton@tutu.fr).

    a l'heure actuelle, lorsque je reçois un mail sur tata ou tonton @tutu.fr, le header du mail indique ce dernier.
    j'ai créé 2 compte smtp qui peuvent répondre avec tata et tonton. Mais le problème c'est que ce n'est pas automatique puisque le compte qui répond par défaut à ces mails reste toto@tutu.fr (compte principale qui reçois les mails et groupes de distri), je me retrouve donc a modifier a chaque fois a la main le compte d'envoi.

    Je recherche activement une macro qui puis (vous l'aurez compris) :
    1- vérifier le récipient qui reçois le mail (toto tata ou tonton).
    2- Grace à cette donnée récupéré en 1, remplacer le champ "de" (expéditeur) par le compte (smtp configuré) ou l'adresse tata tonton ou tutu directement.

    J'ai un peu écumé pas mal de forum et n'ai pas trouvé de réponse viable.

    Par avance merci

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 375
    Points : 5 882
    Points
    5 882
    Billets dans le blog
    16

    Par défaut

    Bonjour,

    Ok je vois bien ton soucis, le problème c'est de retrouver l'adresse de destination.

    A PARTIR DU MAIL RECU

    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
     
     
    Sub test()
        Dim Oitem As Object
        Set Oitem = ActiveInspector.CurrentItem    'désigne l'élément actif càd le mail le contact ou rdv...
        If Oitem.Class <> olMail Then Exit Sub
     
        MsgBox GetToFromHeader(Oitem)
    End Sub
     
     
    Function GetToFromHeader(objMail As Outlook.MailItem) As String
    '---------------------------------------------------------------------------------------
    ' Procedure : GetToFromHeader
    ' Author    : OLIV- from original code brettdj
    ' Date      : 04/06/2015
    ' Purpose   :
    '---------------------------------------------------------------------------------------
    '
        Dim objRegex As Object
        Dim objRegM As Object
        Dim MailHeader As String
        Dim ExtractText As String
        Dim i, j
        Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001F"
        MailHeader = objMail.propertyAccessor.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
     
        Set objRegex = CreateObject("vbscript.regexp")
        Dim Patterns
        Patterns = Array("\nTo:.+<([a-z0-9][a-z0-9-.]{0,32}[a-z0-9]\@[a-z0-9][a-z0-9-]{0,32}[a-z0-9](?:\.[a-z]{2,5}){1,2})>$", _
                         "\nTo:.([a-z0-9][a-z0-9-.]{0,32}[a-z0-9]\@[a-z0-9][a-z0-9-]{0,32}[a-z0-9](?:\.[a-z]{2,5}){1,2})\b")
     
        For j = LBound(Patterns) To UBound(Patterns)
            With objRegex
                .Global = True
                .ignorecase = True
                .MultiLine = True
                '.Pattern = "(\n)To:.*<(.+)>"
     
                '.Pattern = "\nTo:.([a-z0-9][a-z0-9-.]{0,32}[a-z0-9]\@[a-z0-9][a-z0-9-]{0,32}[a-z0-9](?:\.[a-z]{2,5}){1,2})\b"
                .Pattern = Patterns(j)
                If .test(MailHeader) Then
                    Set objRegM = .Execute(MailHeader)
                    For i = 0 To objRegM(0).submatches.Count - 1
                        If InStr(1, objRegM(0).submatches(i), "@", vbTextCompare) Then
                            GetToFromHeader = objRegM(0).submatches(i)
                            Exit Function
                        End If
                    Next i
                Else
                    GetToFromHeader = "No match"
                End If
            End With
        Next j
    End Function
    Pour changer le compte d'envoi à mettre dans ThisOutlookSession

    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
    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    '---------------------------------------------------------------------------------------
    ' Procedure : Application_ItemSend
    ' Author    : OLiv-
    ' Date      : 9/2/2018
    ' Purpose   :envoi en changeant de compte
    '---------------------------------------------------------------------------------------
    '
     
        ' on verifie que c'est un mail
        If Not Item.Class = olMail Then exit sub
            Dim msg As Object, Msg_to As String
        Set msg = FindParentMessage(Application.ActiveInspector.CurrentItem)
        If Not msg Is Nothing Then
            Msg_to = GetToFromHeader(msg)
            If Application.Session.Accounts.Item(1).displayName <> Msg_to and Msg_to <>"No match" Then
                SendUsingAccount Item, Msg_to
            End If
        End If
    End sub
     
     
    Sub SendUsingAccount(oMail, Adresse)
        Dim oAccount As Outlook.Account
        Set oAccount = Application.Session.Accounts(Adresse)
        oMail.SendUsingAccount = oAccount
    End Sub
    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
    Function FindParentMessage(msg As Outlook.MailItem) _
               As Outlook.MailItem
    'http://www.outlookcode.com/codedetail.aspx?id=1714
        Dim strFind As String
        Dim strIndex As String
        Dim fld As Outlook.MAPIFolder
        Dim itms As Outlook.Items
        Dim itm As Outlook.MailItem
        On Error Resume Next
        strIndex = Left(msg.ConversationIndex, _
                        Len(msg.ConversationIndex) - 10)
        Set fld = Application.Session.GetDefaultFolder(olFolderInbox)
        strFind = "[ConversationTopic] = " & _
                  Chr(34) & msg.ConversationTopic & Chr(34)
        Set itms = fld.Items.Restrict(strFind)
        Debug.Print itms.count
        For Each itm In itms
            If itm.ConversationIndex = strIndex Then
                Debug.Print itm.To
                Set FindParentMessage = itm
                Exit For
            End If
        Next
        Set fld = Nothing
        Set itms = Nothing
        Set itm = Nothing
    End Function
    la difficulté c'est de faire la liaison entre l'info du mail RECU et l'envoi de la réponse.

    edit : voilà qui devrait fonctionner

  3. #3
    Nouveau Candidat au Club
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    février 2018
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 28
    Localisation : France, Isère (Rhône Alpes)

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux

    Informations forums :
    Inscription : février 2018
    Messages : 3
    Points : 1
    Points
    1

    Par défaut

    Bonjour,

    D'avance merci pour la réponse,
    Je n'ai pas eu le temps de tester avant.

    Je prends donc le temps de répondre

    J'ai un message d'erreur lorsque j'envoie un message qui est le suivant :

    https://ibb.co/j237TS

    merci pour tout en tout cas

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 375
    Points : 5 882
    Points
    5 882
    Billets dans le blog
    16

    Par défaut

    Bonjour,
    As tu bien copié la fonction FindParentMessage dans un module ?

  5. #5
    Nouveau Candidat au Club
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    février 2018
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 28
    Localisation : France, Isère (Rhône Alpes)

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux

    Informations forums :
    Inscription : février 2018
    Messages : 3
    Points : 1
    Points
    1

    Par défaut

    Et bien du coup, j'ai mis comme tu a mentionné,
    Application_ItemSend et FindParentMessage dans le ThisOutlookSession au départ,
    la je viens de faire différents test et rien n’aboutis malheureusement :/

    actuellement j'ai
    Application_ItemSend dans le outlooksession et
    FindParentMessage dans un module.

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 375
    Points : 5 882
    Points
    5 882
    Billets dans le blog
    16

    Par défaut

    Tu peux tout mettre dans ThisOUtlookSession.

    efface tout et recommence.

Discussions similaires

  1. Problème avec un alias
    Par Olivier Regnier dans le forum Shell et commandes GNU
    Réponses: 12
    Dernier message: 07/09/2006, 22h34
  2. Réponses: 4
    Dernier message: 21/08/2006, 09h38
  3. Modification curseur avec texte entré dans 1 textfield
    Par taillooo dans le forum Général JavaScript
    Réponses: 7
    Dernier message: 14/02/2006, 14h14
  4. FULLTEXT, modif ft_min_word_len avec PHP
    Par Husqvarna dans le forum PHP & MySQL
    Réponses: 3
    Dernier message: 28/10/2005, 10h06

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