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 :

Déplacer un message dans un dossier [OL-2007]


Sujet :

VBA Outlook

  1. #1
    Membre à l'essai
    Profil pro
    Inscrit en
    Septembre 2007
    Messages
    24
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Septembre 2007
    Messages : 24
    Points : 15
    Points
    15
    Par défaut Déplacer un message dans un dossier
    Bonjour !

    J'ai un petit soucis que je n'arrive pas à régler :

    J'ai des 3 messages qui proviennent toujours de la même personnes entre 7h du matin et midi.

    Sur ces messages j'ai crée une règle exécutant un script permettant d'extraire les 3 pièces jointes et de les mettre sur mon pc dans un dossier.

    jusqu'ici tout marche bien.

    Je souhaite ensuite transférer ces messages dans un dossier d'outlook pour les archiver afin que le script ne tourne pas en boucle.

    je crée une règle pour ca je sais faire, mais la règle de transfert de message se fait toujours avant celle du script. Du coup le script ne trouve plus les messages. Même si je met la règle de transfert tout à la fin des autres règles.

    Je ne trouve pas comment faire pour que la règle du script s'effectue avant celle du transfert.

    Si quelqu'un a une idée je suis preneuse !

    merci pour votre aide !

    Nathalie

  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
    Bonjour,
    Ajoutes ton déplacement dans ton script.


    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
    deplacement:
            'on déplace le mail vers un dossier outlook
            If Deplace Then
                Dim myDestFolder As Outlook.MAPIFolder
     
     
     
    'sous dossier de BOITE DE RECEPTION
                Set myDestFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("toto")
     
    'sous dossier au niveau de boite de reception
               Set myDestFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders("toto").Folders("ssdossier")
     
     
     
                If Not myDestFolder Is Nothing Then
                    MyMail.Move myDestFolder
                Else
                    Erreur = Erreur & vbCr & "Email non déplacé :" & DossierMove & " Dossier non trouvé"
                End If
            End If

  3. #3
    Membre à l'essai
    Profil pro
    Inscrit en
    Septembre 2007
    Messages
    24
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Septembre 2007
    Messages : 24
    Points : 15
    Points
    15
    Par défaut déplacer un message dans outlook
    merci oliv' pour ton aide...

    Mais je n'arrive pas à le faire marcher en l’insérant dans mon script. Voici mon script merci pour ton aide !

    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
     
    Dim x As Integer
     
     
       'Permet d'extraire toutes les pj de boite de réception dont le nom se termine par xml
    Sub ExtrairePjXml(Item As Outlook.MailItem)
        Dim Ol As New Outlook.Application
        Dim Ns As Outlook.NameSpace
        Dim Inbox As MAPIFolder
     
        Set Ns = Ol.GetNamespace("MAPI")
        Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
     
        Dim x As Integer
        Dim y As Integer
        Dim OLmail 'As Outlook.MailItem
        Dim pceJointe As Outlook.Attachment
        Dim SousDossier As Outlook.MAPIFolder
     
        If Inbox.DefaultItemType = 0 Then
            For Each OLmail In Inbox.Items
                If Not OLmail.Attachments.Count = 0 Then
                    For y = 1 To OLmail.Attachments.Count
                         Set pceJointe = OLmail.Attachments(y)
                         'pceJointe.SaveAsFile "C:\" & x & "_" & pceJointe
                         If pceJointe.FileName Like "*PROD.NATHALIE*" Then
                            x = x + 1
                            NomDoss = "\\scellius\scellius$\Journaux\" & Format(Date, "ddmmyyyy")
    If Dir(NomDoss, vbDirectory) = "" Then MkDir NomDoss 'Créé le dossier s'il nexiste pas
    pceJointe.SaveAsFile NomDoss & "\" & pceJointe.FileName
     
                         End If
                        Set pceJointe = Nothing
                    Next y
                End If
            Next OLmail
        Else
            MsgBox (Inbox.DefaultItemType)
        End If
     
     Dim myNameSpace As Outlook.NameSpace
     Dim myInbox As Outlook.Folder
     Dim myDestFolder As Outlook.Folder
     Dim myItems As Outlook.Items
     Dim myItem As Object
     
     Set myNameSpace = Application.GetNamespace("MAPI")
     Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
     Set myItems = myInbox.Items
     Set myDestFolder = myInbox.Folders("journaux prod")
     Set myItem = myItems.Find("[SenderName] = 'so_send_journal_fond@sips-atos.com'")
     While TypeName(myItem) <> "Nothing"
     myItem.Move myDestFolder
     Set myItem = myItems.FindNext
     Wend

  4. #4
    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
    Salut
    Tu as déjà un objet qui désigne ton email en cours de traitement donc tu dois utiliser item.move... Et pas myitem

  5. #5
    Membre à l'essai
    Profil pro
    Inscrit en
    Septembre 2007
    Messages
    24
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Septembre 2007
    Messages : 24
    Points : 15
    Points
    15
    Par défaut déplacer un message dans outlook
    Merci pour ton aide,

    je suis débutante en VB donc pas facile pour moi.

    J'ai réussi à faire tourner un script qui effectivement me transfert bien les messages en question dans un dossier Outlook (code ci dessous), mais il est sous forme de module et je ne sais pas comment l’insérer à mon script déjà existant et que je t'avais donné plus haut et qui lui marche très bien avec une règle "d’exécution de script".

    Du coup l'autre étant en module si je recrée une autre règle je ne la trouve pas.

    Il faudrait que j'arrive à réunir les deux mais je suis trop novice.....

    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
    Sub script(mail As MailItem)
     
       DeplacerMessage "so_send_journal_fond@sips-atos.com", "toto"
     
    End Sub
    Function DeplacerMessage(Nom As String, Dossier As String)
        Dim myOlApp As Outlook.Application
        Dim myNamespace As Outlook.NameSpace
        Dim myFolder As Outlook.MAPIFolder
        Dim myItems As Outlook.Items
        Dim myRestrictItems As Outlook.Items
        Dim myItem As Outlook.MailItem
     
        Set myOlApp = Outlook.Application
        Set myNamespace = myOlApp.GetNamespace("MAPI")
        Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
        Set myItems = myFolder.Items
        Set myRestrictItems = myItems.Restrict("[De] = '" & Nom & "'")
        For i = myRestrictItems.Count To 1 Step -1
            myRestrictItems(i).Move myFolder.Folders(Dossier)
        Next
    End Function

  6. #6
    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
    Bonjour,
    En repartant de ton précédent code tu vas voir c'est assez simple

    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
    Dim x As Integer
     
     
       'Permet d'extraire toutes les pj de boite de réception dont le nom se termine par xml
    Sub ExtrairePjXml(Item As Outlook.MailItem)
        Dim Ol As New Outlook.Application
        Dim Ns As Outlook.NameSpace
        Dim Inbox As MAPIFolder
     
        Set Ns = Ol.GetNamespace("MAPI")
        Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
     
        Dim x As Integer
        Dim y As Integer
        Dim pceJointe As Outlook.Attachment
     
     
                If Not item.Attachments.Count = 0 Then
                    For y = 1 To item.Attachments.Count
                         Set pceJointe = item.Attachments(y)
                         'pceJointe.SaveAsFile "C:\" & x & "_" & pceJointe
                         If pceJointe.FileName Like "*PROD.NATHALIE*" Then
                            x = x + 1
                            NomDoss = "\\scellius\scellius$\Journaux\" & Format(Date, "ddmmyyyy")
    If Dir(NomDoss, vbDirectory) = "" Then MkDir NomDoss 'Créé le dossier s'il nexiste pas
    pceJointe.SaveAsFile NomDoss & "\" & pceJointe.FileName
     
                         End If
                        Set pceJointe = Nothing
                    Next y
                End If
     
     Dim myDestFolder As Outlook.Folder
     
     Set myInbox = NS.GetDefaultFolder(olFolderInbox)
     Set myDestFolder = myInbox.Folders("journaux prod")
    Item.Move myDestFolder
    Peux tu me confirmer ce que tu cherches à faire ? Ton script tu l'utilises quand ? avec une règle ?

    Si oui en principe il doit s'exécuter sur le mail qui arrive et répond aux critères définis.

    Précédemment tu lançais ton code à partir d'un email puis tu parcourais tous les Emails de la boite de réception !!

  7. #7
    Membre à l'essai
    Profil pro
    Inscrit en
    Septembre 2007
    Messages
    24
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Septembre 2007
    Messages : 24
    Points : 15
    Points
    15
    Par défaut déplacer un message dans outlook
    bonjour !

    oui le script je l'utilise avec une règle sur la notion "exécuter un script". Ca marche très bien elle crée bien le dossier voulu avec la date du jour sur mon pc dés l'arrivé des 3 messages du jour. Seulement, si après cette action, je ne transfère pas les messages dans autre dossier, le script tourne en boucle et m'incorpore à chaque fois les pièces jointes dans le même dossier.

    Nom : Sans titre.JPG
Affichages : 2208
Taille : 58,9 Ko

  8. #8
    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
    Bonjour,
    Oui c'est normal de la façon dont il était écrit

    As tu essayé mon code modifié ?

  9. #9
    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
    Il faut bien sûr que ta règle comporte un filtre !

    sinon change comme cela à la fin

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    if x>0 then Item.Move myDestFolder

  10. #10
    Membre à l'essai
    Profil pro
    Inscrit en
    Septembre 2007
    Messages
    24
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Septembre 2007
    Messages : 24
    Points : 15
    Points
    15
    Par défaut déplacer un message dans outlook
    Oui j'ai testé voici l'erreur qui sort :

    Nom : Sans titre.JPG
Affichages : 2258
Taille : 88,5 Ko

  11. #11
    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
    il manque juste la ligne "end sub" à la fin

    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
    Dim x As Integer
     
     
       'Permet d'extraire toutes les pj de boite de réception dont le nom se termine par xml
    Sub ExtrairePjXml(Item As Outlook.MailItem)
        Dim Ol As New Outlook.Application
        Dim Ns As Outlook.NameSpace
        Dim Inbox As MAPIFolder
     
        Set Ns = Ol.GetNamespace("MAPI")
        Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
     
        Dim x As Integer
        Dim y As Integer
        Dim pceJointe As Outlook.Attachment
     
     x=0
                If Not item.Attachments.Count = 0 Then
                    For y = 1 To item.Attachments.Count
                         Set pceJointe = item.Attachments(y)
                         'pceJointe.SaveAsFile "C:\" & x & "_" & pceJointe
                         If pceJointe.FileName Like "*PROD.NATHALIE*" Then
                            x = x + 1
                            NomDoss = "\\scellius\scellius$\Journaux\" & Format(Date, "ddmmyyyy")
    If Dir(NomDoss, vbDirectory) = "" Then MkDir NomDoss 'Créé le dossier s'il nexiste pas
    pceJointe.SaveAsFile NomDoss & "\" & pceJointe.FileName
     
                         End If
                        Set pceJointe = Nothing
                    Next y
                End If
     
     Dim myDestFolder As Outlook.Folder
     
     Set myInbox = NS.GetDefaultFolder(olFolderInbox)
     Set myDestFolder = myInbox.Folders("journaux prod")
    if x>0 then Item.Move myDestFolder
    end sub

  12. #12
    Membre à l'essai
    Profil pro
    Inscrit en
    Septembre 2007
    Messages
    24
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Septembre 2007
    Messages : 24
    Points : 15
    Points
    15
    Par défaut déplacer un message dans outlook
    arf...évidemment c'était tout bêtement indiqué....

    Je viens de faire un test ça marche du tonnerre !!!

    milles mercis pour ton aide !!!!

    Au plaisir !

    Nathalie

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

Discussions similaires

  1. Déplacer un mail dans un "dossier personnel" de mon choix
    Par Dailyplanet dans le forum VBA Outlook
    Réponses: 30
    Dernier message: 17/12/2008, 18h45
  2. Réponses: 7
    Dernier message: 15/09/2008, 11h44
  3. Réponses: 2
    Dernier message: 10/06/2008, 14h24
  4. Déplacer des messages dans un autre dossier
    Par ouadie99 dans le forum Outlook
    Réponses: 5
    Dernier message: 26/02/2008, 18h10

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