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 :

Classement automatique des emails ET des rapports (olReport)


Sujet :

VBA Outlook

  1. #1
    Candidat au Club
    Inscrit en
    Juillet 2008
    Messages
    5
    Détails du profil
    Informations forums :
    Inscription : Juillet 2008
    Messages : 5
    Points : 2
    Points
    2
    Par défaut Classement automatique des emails ET des rapports (olReport)
    Bonjour à tous,

    J'essaiede créer une macro pour trier automatiquement mes emails. En somme :
    • Je sélectionne dans ma boîte de réception le ou les emails à classer
    • J'appel la macro "moveToArchive"

    Cette macro fait :
    • Change l'état du email en "lu"
    • Classe le email (ou le rapport) dans le bon répertoire

    Le problème : pas de problème pour classer les emails (class = olMail), par contre c'est une autre paire de manche pour les rapports de lecture (classe = olReport) !

    En fait, je n'arrive pas à trouver l'expéditeur du rapport de lecture, je n'arrive donc pas à le classer. Bien sûr, quand la classe du message est "olReport", la fonction "SenderEmailAddress" n'existe pas, d'ou le problème !

    Mon code :
    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
    Sub moveToArchive()
        'Bligoo - March 2008
        'http://bligoo.wordpress.com/
     
        ' OlObjectClass
        ' olMail = 43
        ' olNote = 44
        ' olPost = 45
        ' olReport = 46
        ' olRemote = 47
        ' Liste complète : http://support.microsoft.com/kb/285202/fr
     
        On Error Resume Next
        Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
        Dim objNS As Outlook.namespace
        Dim objItem As Object    ' Impossible de mettre "MailItem" ???
     
        Set objNS = Application.GetNamespace("MAPI")
        Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
        ' Set objFolder = objNS.Folders("Dossiers 2008")
        ' À retenir : objNS.Folders(”Dossiers personnels”).Folders(”sous dossier”).Folders(”Sous sous dossier”)
        ' Exemple : Set objFolder = objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("MP")
        Set objFolder = objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("MP")
     
        If Application.ActiveExplorer.Selection.Count = 0 Then
            '[asy]Contrôle qu'au moins un message est sélectionné, sinon fin de la macro
     
            Exit Sub
     
        End If
     
        If objFolder Is Nothing Then
            '[asy]Controler que le dossier de destination est valide
            MsgBox "Le dossier cible n'existe pas!", vbOKOnly + vbExclamation, "INVALID FOLDER"
        End If
     
        For Each objItem In Application.ActiveExplorer.Selection
     
            If objFolder.DefaultItemType = olMailItem Then
     
                Select Case objItem.Class
     
                    Case olMail:    ' Courriel
     
                        objItem.UnRead = False    '[asy]Le mail passe dans le statut lu
                        ' objItem.Move objFolder '[asy]Le mail est déplacé dans le répertoire cible
                        NomExp = objItem.SenderName
                        AdresseExp = objItem.SenderEmailAddress
                        Domaine = Split(AdresseExp, "@")
                        Select Case Domaine(1)
                            Case "mailingprocess.com":
                                Select Case Domaine(0)    ' Nom de l'expéditeur
     
                                    Case "SRVVALIPOST1"
     
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Serveur.Valipost")
                                    Case "destineo"
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Serveur.Valipost").Folders("Bordereaux")
                                    Case Else
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("MP")
                                End Select
                            Case "routage-et-marketing.com":
                                objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("RMP")
                            Case "bip.laposte.fr"
                                objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("La Poste").Folders("info@bip.laposte.fr")
                        End Select
     
                    Case olReport:    ' Rapport : Courriel Lu uniquement
     
                        objItem.UnRead = False    '[asy]Le mail passe dans le statut lu
                        ' Impossible d'obtenir le nom de l'expéditeur
                        ' NomExp = objItem.SenderName
                        ' AdresseExp = objItem.SenderEmailAddress
                        ' Domaine = Split(AdresseExp, "@")
     
     
                        ' objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("MP").Folders("Lu")
     
                End Select
     
            End If
     
        Next
     
        Set objItem = Nothing
        Set objFolder = Nothing
        Set objInbox = Nothing
        Set objNS = Nothing
     
    End Sub
    code qui pose problème
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
     Case olReport:    ' Rapport : Courriel Lu uniquement
     
                        objItem.UnRead = False    '[asy]Le mail passe dans le statut lu
                        ' Impossible d'obtenir le nom de l'expéditeur
                        ' NomExp = objItem.SenderName
                        ' AdresseExp = objItem.SenderEmailAddress
                        ' Domaine = Split(AdresseExp, "@")
    Le type olReport n'ayant pas les mêmes propriétés que olMail, impossible de trouver de qui vient le rapport de lecture. Le courrier étant envoyé à plusieurs destinataires, même si je regarde à l'intérieur du "body", je ne trouve pas de qui le message m'est envoyé ! Le plus drôle est qu'il est bien possible de faire répondre mais à partir de l'interface. Dur dur la vie !

    Moi j'ai bien beau chercher, je n'ai rien trouvé pour m'en sortir ! Au secours !

  2. #2
    Expert éminent sénior
    Avatar de Dolphy35
    Homme Profil pro
    Responsable Systemes d'Information
    Inscrit en
    Octobre 2004
    Messages
    4 373
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Responsable Systemes d'Information
    Secteur : Industrie

    Informations forums :
    Inscription : Octobre 2004
    Messages : 4 373
    Points : 11 221
    Points
    11 221
    Par défaut
    Salut,

    je confirme il n'y a aucunes propriétés permettant d'avoir l'expéditeur depuis un ReportItem. Normalement tu as l'adresse mail de l'expéditeur du report dans le body mais là il te faut coder un bon traitement sur chaîne.

    Je ne connais pas mais regarde du côté de CDO, il reprend pas mal de faille d'outlook.


    Dolphy

  3. #3
    Candidat au Club
    Inscrit en
    Juillet 2008
    Messages
    5
    Détails du profil
    Informations forums :
    Inscription : Juillet 2008
    Messages : 5
    Points : 2
    Points
    2
    Par défaut
    Hello Dolphy35,

    Merci pour la réponse, c'est bien ce que je pensais ! C'est quand même incroyable qu'il soit impossible de retrouver l'expéditeur. Le traitement du corp du message n'est pas vraiment utile, le nom de l'expéditeur y est mais pas nécessairement son adresse email !

    Concernant le Collaboration Data Objects (CDO), as-tu un site source à me suggérer ?

    Merci encore pour ta réponse rapide,


  4. #4
    Expert éminent sénior
    Avatar de Dolphy35
    Homme Profil pro
    Responsable Systemes d'Information
    Inscrit en
    Octobre 2004
    Messages
    4 373
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Responsable Systemes d'Information
    Secteur : Industrie

    Informations forums :
    Inscription : Octobre 2004
    Messages : 4 373
    Points : 11 221
    Points
    11 221
    Par défaut
    re,



    Wouapaaa !!!

    c'est pas CDO mais redemption

    http://www.dimastr.com/redemption


    Dolphy

  5. #5
    Candidat au Club
    Inscrit en
    Juillet 2008
    Messages
    5
    Détails du profil
    Informations forums :
    Inscription : Juillet 2008
    Messages : 5
    Points : 2
    Points
    2
    Par défaut
    J'ai honte j'ai honte !

    Merci pour la suggestion, je regarde ça !

    À bientôt,

    André

  6. #6
    Expert éminent sénior
    Avatar de Dolphy35
    Homme Profil pro
    Responsable Systemes d'Information
    Inscrit en
    Octobre 2004
    Messages
    4 373
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Responsable Systemes d'Information
    Secteur : Industrie

    Informations forums :
    Inscription : Octobre 2004
    Messages : 4 373
    Points : 11 221
    Points
    11 221
    Par défaut
    Citation Envoyé par amarcotte Voir le message
    J'ai honte j'ai honte !
    c'est plutôt moi j'ai carrément confondu les deux

    Bon Week

  7. #7
    Candidat au Club
    Inscrit en
    Juillet 2008
    Messages
    5
    Détails du profil
    Informations forums :
    Inscription : Juillet 2008
    Messages : 5
    Points : 2
    Points
    2
    Par défaut
    Yes ! Redemption a la solution ! Juste un petit bout, mais qui donne exactement le résultat recherché :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    Dim sItem, oItem
    Set sItem = CreateObject("Redemption.SafeMailItem")
    Set oItem = Application.Session.GetDefaultFolder(6).Items(1) 'get first e-mail from the Inbox, can be any other item
    sItem.Item = oItem
    PrSenderEmail = &HC1F001E
    MsgBox sItem.Fields(PrSenderEmail)
    MsgBox sItem.Fields(PrSenderEmail) envoi le nom du destinataire, que ce soit un email ou un rapport. Que du bonheur !

    Merci pour ton aide, c'était une excellente suggestion !

  8. #8
    Candidat au Club
    Inscrit en
    Juillet 2008
    Messages
    5
    Détails du profil
    Informations forums :
    Inscription : Juillet 2008
    Messages : 5
    Points : 2
    Points
    2
    Par défaut
    Pour les fana du code, la technique utilisé :

    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
    Function TrouveExpediteur(IDUnique As String) As String
     
    Dim sItem, oItem
     
        Set sItem = CreateObject("Redemption.SafeMailItem")
        Set oItem = Application.Session.GetItemFromID(IDUnique) ' Application.Session.GetDefaultFolder(6).Items(1) 'get first e-mail from the Inbox, can be any other item
     
        sItem.Item = oItem
        PrSenderEmail = &HC1F001E
     
        TrouveExpediteur = sItem.Fields(PrSenderEmail)
     
        Set sItem = Nothing
        Set oItem = Nothing
     
    End Function
    Il s'agit en fait de passer en paramètre l'ID unique du message en cours pour trouver l'adresse destinataire. La fonction principale (je sais, il reste à optimiser !) :

    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
    Sub moveToArchive()
    'Bligoo - March 2008
    'http://bligoo.wordpress.com/
     
     ' OlObjectClass
     '  olMail = 43
     '  olNote = 44
     '  olPost = 45
     '  olReport = 46
     '  olRemote = 47
     '  Liste complète : http://support.microsoft.com/kb/285202/fr
     
        On Error Resume Next
        Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
        Dim objNS As Outlook.NameSpace
        Dim objItem As Object ' Impossible de mettre "MailItem" ???
     
        Set objNS = Application.GetNamespace("MAPI")
        Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
        ' Set objFolder = objNS.Folders("Dossiers 2008")
        ' À retenir : objNS.Folders(”Dossiers personnels”).Folders(”sous dossier”).Folders(”Sous sous dossier”)
        ' Exemple : Set objFolder = objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("MP")
        Set objFolder = objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("MP")
     
        If Application.ActiveExplorer.Selection.Count = 0 Then
            '[asy]Contrôle qu'au moins un message est sélectionné, sinon fin de la macro
            Exit Sub
        End If
     
        If objFolder Is Nothing Then
            '[asy]Controler que le dossier de destination est valide
            MsgBox "Le dossier cible n'existe pas!", vbOKOnly + vbExclamation, "INVALID FOLDER"
        End If
     
        For Each objItem In Application.ActiveExplorer.Selection
            If objFolder.DefaultItemType = olMailItem Then
            NomExp = TrouveExpediteur(objItem.EntryID)
                Select Case objItem.Class
                    Case olMail:    ' Courriel
                        objItem.UnRead = False '[asy]Le mail passe dans le statut lu
                        ' objItem.Move objFolder '[asy]Le mail est déplacé dans le répertoire cible
                        ' NomExp = objItem.SenderName
                        AdresseExp = objItem.SenderEmailAddress
                        Domaine = Split(AdresseExp, "@")
                        Select Case Domaine(1)
                            Case "mailingprocess.com":
                                Select Case Domaine(0)  ' Nom de l'expéditeur
                                    Case "SRVVALIPOST1"
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Serveur.Valipost")
                                    Case "destineo"
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Serveur.Valipost").Folders("Bordereaux")
                                    Case Else
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("MP")
                                End Select
                            Case "routage-et-marketing.com":
                                objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("RMP")
                            Case "bip.laposte.fr"
                                objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("La Poste").Folders("info@bip.laposte.fr")
                            Case "laposte.fr"
                                objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("La Poste")
                            Case "valipost.com":
                                Select Case Domaine(0)  ' Nom de l'expéditeur
                                    Case "rmp"
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Serveur.Valipost")
                                    Case Else
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Valipost")
                                End Select
                        End Select
                    Case olReport:  ' Rapport : Courriel Lu uniquement
                        objItem.UnRead = False '[asy]Le mail passe dans le statut lu
                        ' Impossible d'obtenir le nom de l'expéditeur
                        ' NomExp = objItem.SenderName
                         AdresseExp = NomExp
                         Domaine = Split(AdresseExp, "@")
                        Select Case Domaine(1)
                            Case "mailingprocess.com":
                                Select Case Domaine(0)  ' Nom de l'expéditeur
                                    Case "SRVVALIPOST1"
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Serveur.Valipost")
                                    Case "destineo"
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Serveur.Valipost").Folders("Bordereaux")
                                    Case Else
                                        objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("MP").Folders("Lu")
                                End Select
                            Case "routage-et-marketing.com":
                                objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("Interne").Folders("RMP").Folders("Lu")
                            Case "laposte.fr"
                                objItem.Move objNS.Folders("Dossiers 2008").Folders("Boîte de réception").Folders("La Poste")
                        End Select
                End Select
            End If
        Next
     
        Set objItem = Nothing
        Set objFolder = Nothing
        Set objInbox = Nothing
        Set objNS = Nothing
     
    End Sub
    Ça fonctionne parfaitement, c'est bien à se demander pourquoi Outlook sans Redemption n'était pas capable de faire la "job".

    Encore merci pour la suggestion !

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [WS 2008] Envoyer et recevoir des emails avec des serveurs externes
    Par saracen dans le forum Windows Serveur
    Réponses: 0
    Dernier message: 07/12/2014, 16h30
  2. Réponses: 3
    Dernier message: 13/09/2007, 19h11
  3. Réponses: 4
    Dernier message: 28/03/2007, 22h45
  4. Réponses: 3
    Dernier message: 23/01/2007, 09h14

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