IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
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

VBA Outlook Discussion :

VBA - Trouver expéditeur d'origine aprés un transfert d'email


Sujet :

VBA Outlook

  1. #1
    Membre à l'essai
    Homme Profil pro
    Informaticien autodidacte
    Inscrit en
    Août 2015
    Messages
    31
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Informaticien autodidacte
    Secteur : Industrie

    Informations forums :
    Inscription : Août 2015
    Messages : 31
    Points : 18
    Points
    18
    Par défaut VBA - Trouver expéditeur d'origine aprés un transfert d'email
    Bonjour le forum,

    J'ai créé un petit code (basé sur des codes existants évidemment.... !) qui permet d'enregistrer automatiquement un message et sa PJ dans un dossier précis en renommant la PJ avec le nom de domaine de l'expéditeur, là pas de souci !

    Mon problème survient si le mail d'origine est transféré en interne : le nom de domaine est donc le nôtre.

    Le VBA d'Outlook n'étant pas vraiment documenté, je ne sais pas trop quel objet, méthode ou propriété utiliser pour retrouver l'adresse de l'expéditeur d'origine

    Si quelqu'un a une petite idée, je suis preneur !!

    Merci d'avance,

    ThierryP

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    Bonsoir essaye avec cela

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Function Get_sender_SMTP(Oitem As Outlook.MailItem) As String
        Dim oEU As Outlook.ExchangeUser
        On Error Resume Next
        Set oEU = Oitem.Sender.GetExchangeUser
     
        Get_sender_SMTP = oEU.PrimarySmtpAddress
     
     
        If Get_sender_SMTP = "" Then Get_sender_SMTP = Oitem.SenderEmailAddress
    End Function

  3. #3
    Membre à l'essai
    Homme Profil pro
    Informaticien autodidacte
    Inscrit en
    Août 2015
    Messages
    31
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Informaticien autodidacte
    Secteur : Industrie

    Informations forums :
    Inscription : Août 2015
    Messages : 31
    Points : 18
    Points
    18
    Par défaut
    Bonjour Oliv-,

    Merci pour ton retour !

    Je teste ça dès que possible mais je ne suis pas inquiet

    ThierryP

  4. #4
    Membre à l'essai
    Homme Profil pro
    Informaticien autodidacte
    Inscrit en
    Août 2015
    Messages
    31
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Informaticien autodidacte
    Secteur : Industrie

    Informations forums :
    Inscription : Août 2015
    Messages : 31
    Points : 18
    Points
    18
    Par défaut
    Voici ce que j'ai fait pour tester :

    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
    Sub SVG_Sélection()
    Dim MonOutlook As Outlook.Application
    Dim LeMail As Object
    Dim LesMails As Outlook.Selection
    Set MonOutlook = Outlook.Application
    Set LesMails = MonOutlook.ActiveExplorer.Selection
    For Each LeMail In LesMails
        rr = Get_sender_SMTP(LeMail)
    Next LeMail
    Set LesMails = Nothing
    MsgBox rr
    End Sub
     
    Function Get_sender_SMTP(Oitem As Outlook.MailItem) As String
        Dim oEU As Outlook.ExchangeUser
        On Error Resume Next
        Set oEU = Oitem.Sender.GetExchangeUser
        Get_sender_SMTP = oEU.PrimarySmtpAddress
        If Get_sender_SMTP = "" Then Get_sender_SMTP = Oitem.SenderEmailAddress
    End Function
    La fonction fonctionne mais me renvoie mon adresse et non celle de l'expéditeur d'origine.... Mais du coup est-ce que Outlook et VBA savent retrouver directement cette information ?
    Cela m'éviterait d'aller farfouiller dans le corps du mail pour retrouver un "mailto" et retrouver l'adresse !

    ThierryP

  5. #5
    Membre à l'essai
    Homme Profil pro
    Informaticien autodidacte
    Inscrit en
    Août 2015
    Messages
    31
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Informaticien autodidacte
    Secteur : Industrie

    Informations forums :
    Inscription : Août 2015
    Messages : 31
    Points : 18
    Points
    18
    Par défaut
    Bonjour,

    Une première approche, en partant du principe que dans un email transféré, on trouve toujours un [mailtoxxx@xxx.com] dans un transfert (n'étant pas un spécialiste des emails, c'est peut-être juste un vœu pieux !!) :
    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
     
    Sub Test()
    Dim MonOutlook As Outlook.Application
    Dim LeMail As Object
    Dim LesMails As Outlook.Selection
    Set MonOutlook = Outlook.Application
    Set LesMails = MonOutlook.ActiveExplorer.Selection
    For Each LeMail In LesMails
        Expéditeur = Trouve_Expéditeur(LeMail)
        MsgBox Expéditeur
    Next LeMail
    Set LesMails = Nothing
    End Sub
     
    Function Trouve_Expéditeur(LeMail)
    Lecorps = Split(LeMail.body, vbCrLf)
    For i = 0 To UBound(Lecorps)
        If InStr(Lecorps(i), "[") <> 0 Then
            Début = InStr(Trim(Lecorps(i)), "[") + 8
            Longueur = InStrRev(Trim(Lecorps(i)), "]") - Début
            Adresse = Mid(Lecorps(i), Début, Longueur)
            Trouve_Expéditeur = Adresse
            Exit Function
        End If
    Next
    End Function
    Evidemment, ce n'est pas une solution générale (comment gérer un transfert de transfert par exemple !), mais dans mon cas je dois traiter des messages qui ne sont transférés qu'une seule fois !

    ThierryP

Discussions similaires

  1. [OL-2013] VBA-outlook : envoi de mail après transfert dans brouillons
    Par xantos295 dans le forum VBA Outlook
    Réponses: 9
    Dernier message: 02/03/2017, 10h45
  2. [Toutes versions] VBA Trouver le userform à l'origine de l'ouverture d'un autre userform
    Par lenylett dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 08/10/2015, 11h31
  3. [MySQL] Problème après le transfert de mon script sur internet
    Par LordBob dans le forum PHP & Base de données
    Réponses: 22
    Dernier message: 26/01/2006, 22h02
  4. [VBA]Trouver les cellules fusionnées et autres
    Par SFrane dans le forum Macros et VBA Excel
    Réponses: 24
    Dernier message: 23/01/2006, 14h12
  5. probleme code vba ne s'execute pas apres instruction sql
    Par arnogef dans le forum Requêtes et SQL.
    Réponses: 9
    Dernier message: 29/12/2005, 13h34

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