1. #1
    Nouveau Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    septembre 2017
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : septembre 2017
    Messages : 5
    Points : 1
    Points
    1

    Par défaut [ OL-2010 ] Exécution macro réception mail

    Bonjour à tous,

    Voilà, un client possède un fax to mail, initialement tout cela arrivait sur un poste XP et fonctionnait correctement, le client par précaution la machine XP donnant des signes de faiblesses a voulu déplacer sur un poste Seven avec Outlook 2010.

    N'y connaissant rien en DEV et la personne ayant créé cette routine n'étant plus joignable ... j'ai simplement recopié la macro du poste XP et je l'ai copié sur le poste Seven.

    Celle-ci est censée lorsqu'un mail arrive, extraire la pièce jointe dans un dossier, et déplacer le mail dans les éléments supprimés.

    Il y a donc une règle qui est censée s’exécuter quand un mail arrive qui est créé telle quelle :

    S'applique à la réception d'un message
    Venant de "xxx@zzz.fr"
    Exécuter le script "xxx"

    Cela marche mais le problème est que cela s’exécute avec un mail de décalage ... je m'explique imaginons la boite mail est vide, si je reçois un mail, il ne se passe rien, lors de la réception d'un autre mail la macro s'exécute pour le premier mail mais pas pour le second .. et ainsi de suite ..

    Savez-vous d'où peut provenir se problème ?

    Voici le code de la macro en question :


    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
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    Sub Macro_Extraction_PJ()
     
    '***********************************************
    '* This script gets Outlook email attachements *
    '* and saves them into a specified directory.  *
    '*_____________________________________________*
    '*          By Philippe Heiz, 2003.           *
    '***********************************************
     
    '---------------------------------
    ' CHANGE THE FOLLOWING SETTINGS
    '---------------------------------
     
    Outlook_Archive = "Dos_perso"
    Outlook_Folder = "Boîte de réception"
    Outlook_SubFolder1 = ""
    Outlook_SubFolder2 = ""
    Outlook_SubFolder3 = ""
     
    Subject_InStr = ""
    Get_All_Files = True
    Delete_Mail = True
     
    Target_Folder = "C:\fax_mail\recept\"
    Target_File_Name = ""
     
    Log_File_Long_Name = "C:\fax_mail\log.txt"
     
    '---------------------------------
    ' DO NOT CHANGE THE FOLLOWING CODE
    '---------------------------------
     
        cpt = 0
        Set objOutlook = CreateObject("Outlook.Application")
        Set objFolder = objOutlook.GetNamespace("MAPI").Folders(Outlook_Archive)
     
        If Not Log_File_Long_Name = "" Then Set objFSO = CreateObject("Scripting.FileSystemObject")
        If Not Log_File_Long_Name = "" Then Set objLog = objFSO.CreateTextFile(Log_File_Long_Name)
        If Not Log_File_Long_Name = "" Then objLog.WriteLine Now()
        If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------"
     
        On Error Resume Next
        For i = 0 To 3
        Select Case i
        Case 0
            If Not Outlook_Folder = "" Then
                Set objFolder = objFolder.Folders(Outlook_Folder)
            Else
                Exit For
            End If
        Case 1
            If Not Outlook_SubFolder1 = "" Then
                Set objFolder = objFolder.Folders(Outlook_SubFolder1)
            Else
                Exit For
            End If
        Case 2
            If Not Outlook_SubFolder2 = "" Then
                Set objFolder = objFolder.Folders(Outlook_SubFolder2)
            Else
                Exit For
            End If
        Case 3
            If Not Outlook_SubFolder3 = "" Then
                Set objFolder = objFolder.Folders(Outlook_SubFolder3)
            Else
                Exit For
            End If
        End Select
        Next
     
        If Not Err.Number = 0 Then
        If Not Log_File_Long_Name = "" Then objLog.WriteLine "ERROR: Outlook archive path is not valid:"
        If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_Archive =" & Chr(9) & Outlook_Archive
        If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_Folder =" & Chr(9) & Outlook_Folder
        If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_SubFolder1 =" & Chr(9) & Outlook_SubFolder1
        If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_SubFolder2 =" & Chr(9) & Outlook_SubFolder2
        If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_SubFolder3 =" & Chr(9) & Outlook_SubFolder3
        If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------"
        Exit Sub
        End If
        On Error GoTo 0
     
        Set objItems = objFolder.Items
        For mailIndex = objItems.Count To 1 Step -1
            'On Error Resume Next
            Set objMailItem = objItems.Item(mailIndex)
            If objMailItem.Attachments.Count > 0 Then
                If Not InStr(1, objMailItem.Subject, Subject_InStr, 1) = 0 Then
                    If Not Log_File_Long_Name = "" Then objLog.WriteLine objMailItem.Subject
     
            On Error Resume Next
                    If Get_All_Files Then
                        For i = 1 To objMailItem.Attachments.Count
                            Set PJ = objMailItem.Attachments.Item(i)
                            PJ.SaveAsFile Target_Folder & PJ.DisplayName
                            If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & PJ.DisplayName
                            cpt = cpt + 1
                        Next
                    Else
                        Set PJ = objMailItem.Attachments.Item(1)
                        If Target_File_Name = "" Then Target_File_Name = PJ.DisplayName
                        PJ.SaveAsFile Target_Folder & Target_File_Name
                        If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & PJ.DisplayName
                        cpt = cpt + 1
                    End If
                    If Not Err.Number = 0 Then
                If Not Log_File_Long_Name = "" Then objLog.WriteLine "ERROR: Target path is not valid:"
                If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & Target_Folder
                If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------"
                    Exit Sub
            End If
            On Error GoTo 0
     
                    If Delete_Mail Then objMailItem.Delete
                End If
            End If
        Next
     
        If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------"
        If Not Log_File_Long_Name = "" Then objLog.WriteLine cpt & " attachment(s) treated"
    End Sub
    Merci beaucoup.

  2. #2
    Expert éminent

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    2 336
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 2 336
    Points : 6 140
    Points
    6 140
    Billets dans le blog
    19

    Par défaut

    Citation Envoyé par Radack08 Voir le message
    Bonjour,

    Modifiez peut-être votre boucle For MailIndex (sans garantie) :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
      Set objItems = objFolder.Items
        For mailIndex = objItems.Count To 1 Step -1
            'On Error Resume Next
            Set objMailItem = objItems.Item(mailIndex)
    En :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
      Set objItems = objFolder.Items
        For mailIndex = objItems.Count-1 To 0 Step -1
            'On Error Resume Next
            Set objMailItem = objItems.Item(mailIndex)
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  3. #3
    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,
    Je ne pense pas que le code publié puisse être utilisé comme script ! as tu modifié ce code ?


    il devrait comportait un argument comme
    Sub regle_exportPJ(Mail As Outlook.MailItem)
    Call ExportSuppression_PJ_V2(Mail, True, True, False, "c:\temp\newexportmsg", True, "\\maboite\Boîte de réception\Test", True)
    End Sub

    voici une routine qui fait cela très bien

    https://www.developpez.net/forums/bl...yperlien-mail/

  4. #4
    Nouveau Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    septembre 2017
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : septembre 2017
    Messages : 5
    Points : 1
    Points
    1

    Par défaut

    Bonjour,

    Je n'ai rien modifié du tout, je n'ai aucune compétence dans ce domaine malheureusement :/

    Merci beaucoup pour le lien du coup je dois juste reprendre le code que tu as donné et y ajouter :

    Classement du mail dans un Dossier OUTLOOK différent -->Deplace:=true en renseignant le dossier DossierMove ="C:\temp\"

    Afin de faire à la réception d'un mail

    Extraction PJ dans un dossier ( c:\fax_mail\Recept )
    Déplacement vers les éléments supprimés

    Comment intégré le déplacement à ce script ?

    Merci beaucoup

  5. #5
    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

    Sur l'ancien poste qu'est ce qui était noté dans la règle pour la valeur de XXX ?
    "Exécuter le script "xxx""
    La macro ne se charge pas que de traiter le dernier mail , mais en principe elle parcourt tous les Emails de la boite !

    Est ce que ces Emails/fax on un sujet vide ?


    edit : est ce que la boite se nomme Dos_perso ? ou alors il faut traiter la boite de reception par defaut ?

  6. #6
    Nouveau Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    septembre 2017
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : septembre 2017
    Messages : 5
    Points : 1
    Points
    1

    Par défaut

    Pareil que sur le poste actuel c'est à dire "Projet 1.Extraction.PJ"

    Voici un screen du mail type reçu :



    Merci beaucoup de ton aide

    edit : il n'y a qu'une boite de configuré sur le poste, celle du fax et la boite s'appelle effectivement dos_perso ( aucune idée pourquoi elle a été renommé ainsi ^^ )

    edit 2 : j'ai dit une connerie, il y a deux boites mails de configurées mais la boite concernée reste dos_perso

  7. #7
    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

    donc tu dois avoir une macro dans un module Extraction qui se nomme "PJ"

  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

    Bon je confirme le phénomène sur OL2010, le mail qui déclenche la règle n'est pas traité par une macro qui parcourerait tous les items de la boite de réception, c'est comme s'il n'était pas encore là !

    Donc il faut traiter le mail arrivant et éventuellement traiter les autres Emails qui répondent aux critères et qui seraient encore dans la BAL.

    Le code a été développé de la sorte sans doute à cause d'une contrainte de OUTLOOK 2003 c'est bien ce programme qui était sur ton XP ?

    Mais de toute façon un script qui s’exécute via une règle comporte un argument ITEM

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Sub Extraction_PJ(Item As Outlook.MailItem)
    donc en principe on utilise cet OBJET "ITEM" qui est le mail arrivé, pour traiter ce mail t ainsi de suite avec les suivants.

  9. #9
    Nouveau Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    septembre 2017
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : septembre 2017
    Messages : 5
    Points : 1
    Points
    1

    Par défaut

    Effectivement on dirait que lorsqu'un mail arrive la macro ne s'applique pas sur lui ... même lorsque je rajoute à la règle de déplacer dans un dossier spécifique avant l’exécution de la macro, le mail va bien dans le dossier mais la macro .. nada.

    Oui c'est bien Outlook 2003 qu'il y a sur le poste XP. Le code n'est donc plus valable ?

  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

    Voici comment il devrait être

    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
    Sub Extraction_PJ(Item As Outlook.MailItem)
     
    '***********************************************
    '* This script gets Outlook email attachements *
    '* and saves them into a specified directory.  *
    '*_____________________________________________*
    '*          By Philippe Heiz, 2003.           *
    '*   update Oliv'   2017                      *
    '***********************************************
     
        '---------------------------------
        ' CHANGE THE FOLLOWING SETTINGS
        '---------------------------------
     
        Subject_InStr = ""
        Get_All_Files = True
        Delete_Mail = True
     
        Target_Folder = "C:\fax_mail\recept\"
     
        Target_File_Name = ""
        Log_File_Long_Name = "C:\fax_mail\log.txt"
     
     
        '---------------------------------
        ' DO NOT CHANGE THE FOLLOWING CODE
        '---------------------------------
     
        Cpt = 0
     
        If Not Log_File_Long_Name = "" Then Set objFSO = CreateObject("Scripting.FileSystemObject")
        If Not Log_File_Long_Name = "" Then Set objLog = objFSO.CreateTextFile(Log_File_Long_Name)
        If Not Log_File_Long_Name = "" Then objLog.WriteLine Now()
        If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------"
     
     
        'On Error Resume Next
        If Item.Attachments.Count > 0 Then
            If Not InStr(1, Item.Subject, Subject_InStr, 1) = 0 Then
                If Not Log_File_Long_Name = "" Then objLog.WriteLine Item.Subject
     
                On Error Resume Next
                For i = 1 To Item.Attachments.Count
                    Set PJ = Item.Attachments.Item(i)
                    PJ.SaveAsFile Target_Folder & PJ.DisplayName
                    If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & PJ.DisplayName
                    Cpt = Cpt + 1
                Next
                If Delete_Mail Then Item.Delete
     
            End If
        End If
        If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------"
        If Not Log_File_Long_Name = "" Then objLog.WriteLine Cpt & " attachment(s) treated"
        Set objLog = Nothing
        On Error GoTo 0
     
    End Sub

  11. #11
    Nouveau Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    septembre 2017
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : septembre 2017
    Messages : 5
    Points : 1
    Points
    1

    Par défaut

    Ça marche nickel je te remercie beaucoup !

Discussions similaires

  1. NewmailEX éxecution macro à réception de mail
    Par cissou21 dans le forum VBA Outlook
    Réponses: 5
    Dernier message: 26/05/2012, 06h05
  2. protection feuille + exécuter macros
    Par Fab_nabou dans le forum Macros et VBA Excel
    Réponses: 19
    Dernier message: 04/12/2006, 11h14
  3. Exécution Macro Excel à partir d'Access
    Par SylvainJ dans le forum Access
    Réponses: 1
    Dernier message: 11/08/2006, 14h58
  4. [Mail] Problème réception mail/pieces jointes
    Par pymouse dans le forum Fonctions
    Réponses: 1
    Dernier message: 18/04/2006, 17h07
  5. [VBA][Excel]Exécution macro avec fichiers source
    Par ouezon dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 24/12/2005, 00h00

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