1. #1
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2016
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yonne (Bourgogne)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2016
    Messages : 9
    Points : 4
    Points
    4

    Par défaut Récuperer PJ puis suppr en fonction du sous dossier et d'emetteur du mail

    Bonjour,

    En faisant des recherches sur le net, j'ai trouvé une macro que j'ai adapté à mon besoin.

    Mais j'aimerais lui ajouter des fonctions...

    Aujourd'hui, via VBA dans Excel, la macro va cherche les PJ dans un sous dossier nommé AAA dans Outlook, elle extrait les PJ et leurs donnent un numéro et un nom.

    Voici le 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
    Option Explicit
    '------------------------------------------------------------------------
    'Nécessite d'activer la référence Microsoft Outlook xx.xx Object Library
    '------------------------------------------------------------------------
     
    Dim x As Integer
    Sub downloadPJ()
        Dim Ol As New outlook.Application
        Dim Ns As outlook.Namespace
        Dim Dossier As outlook.MAPIFolder
     
        Set Ns = Ol.GetNamespace("MAPI")
        Set Dossier = Ns.Folders(1)
     
        SearchFolders Dossier
        x = 0
    End Sub
     
     
      Private Sub SearchFolders(ByVal fld As outlook.MAPIFolder)
    Dim y As Integer
    Dim olmail As Object
    Dim olmails As outlook.MailItem
    Dim pceJointe As outlook.Attachment
    Dim SousDossier As outlook.MAPIFolder
     
    For Each SousDossier In fld.Folders
     
        If SousDossier = "AAA" Then
            For Each olmail In SousDossier.Items
            MsgBox olmail.SenderEmailAddress
                If Not olmail.Attachments.Count = 0 Then
                 If olmails.SenderEmailAddress = "test@test.com" Then
                        y = 1
                         Set pceJointe = olmails.Attachments(y)
                         x = x + 1
                         pceJointe.SaveAsFile "d:\TRAITEMENT\" & x & "_" & pceJointe
                        'olmail.Delete a créer
                        Set pceJointe = Nothing
                        End If
                End If
            Next olmail
        End If
        SearchFolders SousDossier
    Next SousDossier
    End Sub

    Je souhaiterais si possible que la macro verifier l'adresse mail mais le code ne fonctionne pas.. Pourtant en message box, il trouve bien l'adresse mail..
    Je souhaiterais aussi qu'elle supprime le mail après avoir extrait la PJ. J'ai réussi sur une autre macro mais je n'arrive pas à mixer les deux.

    Enfin, je cherche une cherche une function qui permet de compter le nombre de mail dans le sous dossier AAA
    En gros, si le nombre de mail ne correspond pas, la macro attend l'arrivée des mails (pour palier au problème réseau) ^^

    Merci d'avance, si vous avez des idées pour m'orienter

    Merci

    Repi17

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 008
    Points : 5 261
    Points
    5 261
    Billets dans le blog
    13

    Par défaut

    Bonjour,

    TOn Test de l'Email ne fonctionne pas sans doute parce que tu as mélangé olmails et olmail

    Pourquoi parcours tu tous les DOSSIERS (For Each SousDossier In fld.Folders) ?

    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
    Option Explicit
    '------------------------------------------------------------------------
    'Nécessite d'activer la référence Microsoft Outlook xx.xx Object Library
    '------------------------------------------------------------------------
     
    Dim x As Integer
    Sub downloadPJ()
        Dim Ol As New outlook.Application
        Dim Ns As outlook.Namespace
        Dim Dossier As outlook.MAPIFolder
     
        Set Ns = Ol.GetNamespace("MAPI")
        Set Dossier = Ns.Folders(1)
     
        SearchFolders Dossier
        x = 0
    End Sub
     
    Private Sub SearchFolders(ByVal fld As Outlook.MAPIFolder)
        Dim y As Integer
        Dim olmail As Object
        Dim olmails As Outlook.MailItem
        Dim pceJointe As Outlook.Attachment
        Dim SousDossier As Outlook.MAPIFolder
     
        For Each SousDossier In fld.Folders
            If SousDossier = "AAA" Then
            MsgBox SousDossier.Items.Count, vbInformation, "nombre de items dans AAA"
     
     
     
                For Each olmail In SousDossier.Items
                    If olmail.Class = olmail Then
                        Set olmails = olmail
                        MsgBox olmails.SenderEmailAddress
                        If Not olmails.Attachments.Count = 0 Then
                            If olmails.SenderEmailAddress = "test@test.com" Then
                                y = 1
                                Set pceJointe = olmails.Attachments(y)
                                x = x + 1
                                pceJointe.SaveAsFile "d:\TRAITEMENT\" & x & "_" & pceJointe
                                'olmail.Delete a créer
                                Set pceJointe = Nothing
                            End If
                        End If
                    Next olmail
     
     
     
     
                End If
                SearchFolders SousDossier
            Next SousDossier
        End Sub
    Par contre si tu veux supprimer les Mails il faut procéder autrement que par "FOR EACH"

    tu dois faire une boucle comme cela

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    For i = SousDossier.Items.Count to 1 step-1
     
     If  SousDossier.Items(i).Class = olmail Then
                        Set olmails = SousDossier.Items(i)
    '....
     
    olmails.delete
    End if
     
    Next i
    regarde ici : traitement recursif
    https://www.developpez.net/forums/bl...sous-dossiers/

    et là export de pj
    https://www.developpez.net/forums/bl...yperlien-mail/

  3. #3
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2016
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yonne (Bourgogne)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2016
    Messages : 9
    Points : 4
    Points
    4

    Par défaut

    Merci pour la réponse

    Le .count c'est nickel !!

    Je boucle pour trouver le bon dossier car je ne sais pas comment faire pour chercher directement le bon. Je vois bien la fonction dans le lien que tu m'as envoyé mais je sais pas l'appliquer.

    Oui j'avais une faute de frappe, mais même sans, ça ne change rien.

    Merci

    Je regarde les liens que tu m'as envoyé.

    Pour la fonction suppression, je vais la mettre dans une autre partie de la macro.

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 008
    Points : 5 261
    Points
    5 261
    Billets dans le blog
    13

    Par défaut

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    SET SousDossier =fld.Folders("AAA")
    as tu testé le code que j'ai corrigé ?

  5. #5
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2016
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yonne (Bourgogne)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2016
    Messages : 9
    Points : 4
    Points
    4

    Par défaut

    Oui je l'ai testé

    Mais j'ai une erreur avec cette ligne :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
                        Set olmails = olmail
    Je regarde demain matin pour l'accès au dossier direct sans boucle.

    Merci encore !!

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 008
    Points : 5 261
    Points
    5 261
    Billets dans le blog
    13

    Par défaut

    Bonjour,
    c'est parce que c'est une constante de OULTOOK

    Const olMail = 43 (&H2B)
    Membre de Outlook.OlObjectClass

    Remplace olMail par oMail ou objMail ou autre chose

  7. #7
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2016
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yonne (Bourgogne)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2016
    Messages : 9
    Points : 4
    Points
    4

    Par défaut

    Bonjour, j'ai toujours l'erreur.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
                          If omail.Class = omail Then
                        Set olmails = omail
    Pour :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
        Set SousDossier = fld.Folders("AAA")
    ça fonctionne, si je place mon sous dossier en dehors de ma boite de réception, mais il ne trouve pas mon sous dossier AAA dans le sous dossier "Boite de réception".
    Je ne sais pas si je suis bien comprehensible :/

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 008
    Points : 5 261
    Points
    5 261
    Billets dans le blog
    13

    Par défaut

    il y a un olmail qui doit rester
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    If omail.Class = olmail Then
                        Set omails = omail

  9. #9
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2016
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yonne (Bourgogne)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2016
    Messages : 9
    Points : 4
    Points
    4

    Par défaut

    J'ai essayé ça, ça fonctionne bien :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
                    Set omails = SousDossier.Items(i)
     
                        MsgBox omails.Sender.GetExchangeUser.PrimarySmtpAddress
     
                        If Not omails.Attachments.Count = 0 Then
     
                            If omails.Sender.GetExchangeUser.PrimarySmtpAddress = "test@test.com" Then

    Merci !!!

    Si tu as une idée pour le sous-dossier qui se trouve dans "Boite de réception" sans boucle

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 008
    Points : 5 261
    Points
    5 261
    Billets dans le blog
    13

    Par défaut

    alors çà c'est le cas où ton email arrive de ton domaine exchange

    sinon de l'extérieur c'est bien senderemailaddress

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    Private 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
    attention à la casse quand même avec ton "=" (voir OPTION COMPARE TEXT ou STRCOMP)



    pour le dossier j'ai répondu là https://www.developpez.net/forums/d1...l/#post9606845

  11. #11
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2016
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yonne (Bourgogne)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2016
    Messages : 9
    Points : 4
    Points
    4

    Par défaut

    Bonjour,

    C'est noté pour le exchange, je ne connais pas encore l'adresse mail qui m'enverra les données.

    J'ai vu pour ta réponse : https://www.developpez.net/forums/d1...l/#post9606845

    Mais c'est ce que j'expliquais dans mon precedent post. Cela fonctionne mais je dois placer le sous dossier AAA sous mon adresse mail dans outlook et on pas sous mon dossier boîte de reception.


    Exemple : (dans la colonne gauche de outlook) :


    Favoris
    Boîte de réception
    Elements envoyés
    Elements supprimés
    ____________________________________
    test@test.com
    AAA
    Boîte de reception
    Sous dossier 1
    Sous dossier 2
    Sous dossier 3
    Sous dossier 4


    Idealement, je souhaiterai placé le sous dossier AAA au meme niveau que les autres sous dossiers mais ça reste que du detail.


    Si tu as une idée..

    Merci pour l'ensemble ;à

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 008
    Points : 5 261
    Points
    5 261
    Billets dans le blog
    13

    Par défaut

    Salut,
    donc si c'est ta boite principale et que AAA est au même niveau que BOITE DE RECEPTION

    J'ai pas testé mais ce code doit fonctionner

    ps tu lances directement dans OUTLOOK ou via EXCEL ?

    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
     Option Explicit
    '------------------------------------------------------------------------
    'Nécessite d'activer la référence Microsoft Outlook xx.xx Object Library
    '------------------------------------------------------------------------
     
    Dim x As Integer
    Sub downloadPJ()
     
        Dim OL As Outlook.Application
        If UCase(Application) = "OUTLOOK" Then
            Set OL = Application
        Else
            Set OL = CreateObject("outlook.application")
        End If
        Dim Ns As Outlook.NameSpace
        Dim Dossier As Outlook.MAPIFolder
     
        Set Ns = OL.GetNamespace("MAPI")
        Set Dossier = Ns.GetDefaultFolder(olFolderInbox).Parent
        Set SousDossier = Dossier.Folders("AAA")
        MsgBox Dossier    'pour tester
        SearchFolders Dossier
        x = 0
    End Sub
     
     
     
     
    Private Sub SearchFolders(ByVal SousDossier As Outlook.MAPIFolder)
        Dim y As Integer, i
        Dim oMail As Outlook.MailItem
        Dim pceJointe As Outlook.Attachment
     
     
        MsgBox SousDossier.Items.Count, vbInformation, "nombre de items dans AAA"
     
        For i = SousDossier.Items.Count To 1 Step -1
     
            If SousDossier.Items(i).Class = olmail Then
                Set oMail = SousDossier.Items(i)
                MsgBox oMail.SenderEmailAddress
                If Not oMail.Attachments.Count = 0 Then
                    If StrComp(Get_sender_SMTP(oMail), "test@test.com", vbTextCompare) = 0 Then
                        y = 1
                        Set pceJointe = oMail.Attachments(y)
                        x = x + 1
                        pceJointe.SaveAsFile "d:\TRAITEMENT\" & x & "_" & pceJointe
                        Set pceJointe = Nothing
                        oMails.Delete
                    End If
                End If
            End If
        Next i
    End Sub
     
     
    Private 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

Discussions similaires

  1. Equivalent de la fonction NVL sous oracle en SQL-server
    Par MorbidAngel dans le forum MS SQL-Server
    Réponses: 2
    Dernier message: 27/09/2005, 10h50
  2. Existe-t-il une fonction Eval() sous Delphi ?
    Par Hell dans le forum Langage
    Réponses: 5
    Dernier message: 20/12/2004, 17h45
  3. Fonction "Format" sous SQL
    Par Fabby69 dans le forum MS SQL-Server
    Réponses: 7
    Dernier message: 08/10/2004, 09h07
  4. fonction "inb" sous linux; port parallele
    Par be_net dans le forum Autres éditeurs
    Réponses: 1
    Dernier message: 09/06/2004, 11h39
  5. Fonction EXTRACT sous Informix
    Par lord_of_ankou dans le forum Informix
    Réponses: 3
    Dernier message: 20/08/2003, 17h37

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