Discussion :

[snips67]

Bonjour,

J'ai besoin d'aide pour ma première macro Outlook, (je suis un peu perdu sans l'enregistreur de macro, présent dans excel par exemple...)

Chaques jours, je recois 2 emails automatiques provenant de la même adresse email, le 1er à 07h05 et le 2eme à 12h04, les 2emails ont exactement la même syntaxe pour le contenu, l'objet etc...

J'aimerais en fait transférer automatiquement l'email de 12h04 à une autre adresse email.

Déja est-ce que c'est possible ?

Ensuite, quels sont les objets que je devrait utiliser ? (j'ai vraiment très peu de notions en programmation objet)

Edit : j'ai trouvé ce bou de code (merci à son auteur), seulement il reste la condition a modifier, a savoir, recuperer l'heure et les minutes ou l'email est receptionné par outlook pour le comparer à 12h04 et si c'est le cas a renvoyer ce même mail a l'autre adresse email...

Et la j'avoue que je suis un peu bloqué ^^

Edit : Je vien de trouver pour recuperer l'heure et les minutes ou le mail arrive !

me manque plus que le transfert

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
 
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'---------------------------------------------------------------------------------------
' Procédure : Application_NewMailEx
' Auteur    : Dolphy35
' Site      : http://dolphy35.developpez.com
' Détail    : Permet de déplacer le nouveau message si celui-ci est envoyé par un expéditeur précis
'---------------------------------------------------------------------------------------
'
    'Déclarations
    Dim MonApp As Outlook.Application
    Dim MonMail As Object
    Dim MonNameSpace As Outlook.NameSpace
 
    'Instance des objets
    Set MonApp = Outlook.Application
    Set MonNameSpace = MonApp.GetNamespace("MAPI")
    Set MonMail = Application.Session.GetItemFromID(EntryIDCollection)
 
        'Test si l'expéditeur correspond dans ce cas on déplace le mail
        'vers le dossier Temp de votre boîte de réception
 
'rajouter une condition pour verifier l'heure de reception de l'email
        If MonMail.SenderEmailAddress = "personne@domaine.fr" Then
 
'code pour transferer a une autre adresse email
 
        End If
 
End Sub

J'attends vos conseils avec impatiences !

[snips67]

Pour le moment j'ai fait ca

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
 
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
 
    'Déclarations
    Dim MonApp As Outlook.Application
    Dim MonMail As Object
    Dim MonNameSpace As Outlook.NameSpace
 
    Dim heure As Integer
    Dim minute As Integer
 
 
 
    'Instance des objets
    Set MonApp = Outlook.Application
    Set MonNameSpace = MonApp.GetNamespace("MAPI")
    Set MonMail = Application.Session.GetItemFromID(EntryIDCollection)
 
    'recupere l'heure et les minutes de reception de l'email
    heure = Mid(MonMail.ReceivedTime, 12, 2)
    minute = Mid(MonMail.ReceivedTime, 15, 2)
 
        'Test si l'expéditeur et l'heure correspondent dans ce cas on déplace le mail
        If MonMail.SenderEmailAddress = "ezrzerzerze@gmail.com" And heure = 8 And minute = 57 Then
            Call Transfert
        End If
 
End Sub
 
Sub Transfert()
 
Dim oOlExp As Explorer
Dim oOlSel As Selection
Dim oOlItm As MailItem
Dim oOlFwd As MailItem
 
Set oOlExp = ActiveExplorer
Set oOlSel = oOlExp.Selection
 
For Each oOlItm In oOlSel
   Set oOlFwd = oOlItm.Forward
   oOlFwd.Recipients.Add "ezrrzerz@gmail.com"
   oOlFwd.Send
Next oOlItm
 
Set oOlFwd = Nothing
Set oOlItm = Nothing
Set oOlSel = Nothing
Set oOlExp = Nothing
 
End Sub

Et ca fonctionne ! mais pas comme je veux

En fait ma procedure transfert, le dernier email que j'ai selectionné dans ma boite de réception et j'aimerais transférer le dernier email recu....

Si quelqu'un à la solution, merci d'avance

[pc75]

Bonjour,

Tu peux boucler sur les "non lus" :

Ce bout de code doit pouvoir s'adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
NonLus = ActiveExplorer.CurrentFolder.UnReadItemCount
For i = 1 To NonLus
    If ActiveExplorer.CurrentFolder.UnReadItemCount = 0 Then
        Exit Sub
    End If
 
    If ActiveExplorer.CurrentFolder.Items.Item(i).ReceivedTime = ??? Then
        ' Appel du transfert
    End If
Next i

[snips67]

Bonjour,

Merci de ta réponse.

Pourrait tu expliquer ce que fait réellement ton code ?

Le probleme est que s'il y'a plusieurs messages non lu dans ma boite de réception qui rentrent dans mon If, ca risque peut être de poser problême. De plus ta technique impose (je crois), d'avoir la boite de réception selectionnée, hors ce n'est pas moi qui va utiliser cette macro, et je ne connais pas les habitudes de l'utilisateur qui va s'en servir.

Avec mon code, je récupère l'email de l'expediteur du dernier mail que je recois :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Set MonMail = Application.Session.GetItemFromID(EntryIDCollection)
MonMail.SenderEmailAddress

Il n'y a pas une méthode qui permet de récuperer le mail tout entier ? (pas juste le nom de l'expediteur)

En fait moi j'avais penser faire ca :

Récuperer l'email tout entier pour pouvoir le send à xx@xx.fr

Ca doit pas être bien compliqué, reste juste à trouver comment ^^

Je vien d'avoir une petite idée pour une autre solution, j'ai esseayer de trouver mais je ne sais pas si c'est possible non plus.

J'ai crée une règle avec outlook, qui fait le transfert, si je recois un email provenant de l'adresse que je veux transferer, à celle que je veux... (peut être pas très clair ^^).

Enfin bon, cette règle fait le transfert tout seul en fait des que je recois un email provenant de xx@xx.fr.

J'ai désactivé cette règle.

Et pourquoi pas faire une macro qui ferait que :

Quand je recois un message :

Vérifier si l'email correspond, si la tranche horaire est bonne, dans ce cas, activer la règle qui transfert le message, effectuer le transfert, et désactiver la règle.

Des conaisseurs ? :p

Mon code aux dernières nouvelles (qui ne fonctionne pas comme je veux ^^)

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
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
 
    'Déclarations
    Dim MonApp As Outlook.Application
    Dim MonMail As Object
    Dim MonNameSpace As Outlook.NameSpace
 
    Dim heure As Integer
    Dim minute As Integer
 
    'Instance des objets
    Set MonApp = Outlook.Application
    Set MonNameSpace = MonApp.GetNamespace("MAPI")
    Set MonMail = Application.Session.GetItemFromID(EntryIDCollection)
 
 
 
        'On boucle sur les mails non lu
        NonLus = ActiveExplorer.CurrentFolder.UnReadItemCount
        For i = 1 To NonLus
        If ActiveExplorer.CurrentFolder.UnReadItemCount = 0 Then
            Exit Sub
        End If
 
    'recupere l'heure et les minutes de reception de l'email
    heure = Mid(ActiveExplorer.CurrentFolder.Items.Item(i).ReceivedTime, 12, 2)
 
 
        'Test si l'expéditeur et l'heure correspondent dans ce cas on déplace le mail
       If MonMail.SenderEmailAddress = "voltzenlogel.julien@gmail.com" And heure > 9 And heure < 20 Then
 
            Call Transfert
        End If
        Next
 
End Sub
 
Sub Transfert()
 
Dim oOlExp As Explorer
Dim oOlSel As Selection
Dim oOlItm As MailItem
Dim oOlFwd As MailItem
 
Set oOlExp = ActiveExplorer
Set oOlSel = oOlExp.Selection
 
For Each oOlItm In oOlSel
   Set oOlFwd = oOlItm.Forward
   oOlFwd.Recipients.Add "ezrrzerz@gmail.com"
   oOlFwd.Send
Next oOlItm
 
Set oOlFwd = Nothing
Set oOlItm = Nothing
Set oOlSel = Nothing
Set oOlExp = Nothing
 
End Sub

[snips67]

J'ai encore avancé un petit peu

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
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
 
    'Déclarations
    Dim MonApp As Outlook.Application
    Dim MonMail As Object
    Dim MonNameSpace As Outlook.NameSpace
    Dim email As Outlook.MailItem
 
    Dim heure As Integer
    Dim minute As Integer
 
    'Instance des objets
    Set MonApp = Outlook.Application
    Set MonNameSpace = MonApp.GetNamespace("MAPI")
    Set MonMail = Application.Session.GetItemFromID(EntryIDCollection)
 
        'On boucle sur les mails non lu
        NonLus = ActiveExplorer.CurrentFolder.UnReadItemCount
        For i = 1 To NonLus
 
        If ActiveExplorer.CurrentFolder.UnReadItemCount = 0 Then
            Exit Sub
        End If
 
    'recupere l'heure et les minutes de reception de l'email
    heure = Mid(ActiveExplorer.CurrentFolder.Items.Item(i).ReceivedTime, 12, 2)
 
        'Test si l'expéditeur et l'heure correspondent dans ce cas on déplace le mail
       If MonMail.SenderEmailAddress = "aaaa@gmail.com" And heure > 8 And heure < 20 Then
       MsgBox "TEST"
            Call Transfert
        End If
        Next i
 
End Sub
 
Sub Transfert()
 
Dim oOlExp As Explorer
Dim oOlSel As Selection
Dim oOlItm As MailItem
Dim oOlFwd As MailItem
 
Set oOlExp = ActiveExplorer
Set oOlSel = oOlExp.Selection
 
For Each oOlItm In oOlSel
   Set oOlFwd = oOlItm.Forward
   oOlFwd.Recipients.Add "zzzz@gmail.com"
   oOlFwd.Send
Next oOlItm
 
Set oOlFwd = Nothing
Set oOlItm = Nothing
Set oOlSel = Nothing
Set oOlExp = Nothing
 
End Sub

Je recupere bien l'index des mails non lu les un apres les autres, mais le problème c'est que je ne sais pas comment les selectionner en fonction de leur index que je recupere....

(je rappel que ma fonction qui transfert l'email ne fonctionne qu'avec l'email qui est sélectionnée)

J'ai lu ca dans l'initiation au VBA :

L'objet MailItem correspond à un E-mail situé dans un dossier pouvant contenir des E-mails. En instanciant cet objet à un E-mail vous pouvez par ses propriétés et méthodes récupérer des informations ou manipuler cet E-mail. La méthode CreateItem permet, par exemple, de créer un nouvel E-mail. Vous pouvez également sélectionner un E-mail spécifique par la méthode Items, celle-ci permet par l'index de la méthode de définir un message particulier par sa position dans la collection d'objets, autre méthode chaque E-mail possède un ID c'est une chaîne de type String propre à chaque mail, cette chaîne est unique par mail et permet de retrouver l'objet depuis la banque MAPI.
Passons aux exemples :

le problème est que je ne sais pas comment m'en servir (pas vu le language objet en cours pour l'instant).

Pitié mon cerveau surchauffe :p

[snips67]

J'ai enfin réussis !

Voilà 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
47
48
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
 
    'Déclarations
    Dim MonApp As Outlook.Application
    Dim MonMail As Object
    Dim MonNameSpace As Outlook.NameSpace
    Dim email As Outlook.MailItem
 
    'Instance des objets
    Set MonApp = Outlook.Application
    Set MonNameSpace = MonApp.GetNamespace("MAPI")
    Set MonMail = Application.Session.GetItemFromID(EntryIDCollection)
 
    Call transfert
 
End Sub
 
Sub transfert()
 
'Procedure de transfert du message
 
Dim folder As String
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
 
longueur = myfolder.Items.Count
 
'recupere le dernier email
Set myitem = myfolder.Items(longueur)
 
Set myforward = myitem.Forward
 
' Adresse email a qui l'on veux transferer
myforward.Recipients.Add "aaaaa@gmail.com"
 
 
'recupere l'heure et les minutes de reception de l'email
heure = Mid(myitem.ReceivedTime, 12, 2)
 
     'Test si l'expéditeur et l'heure correspondent dans ce cas on déplace le mail
    If myitem.SenderEmailAddress = "xxx@gmail.com" And heure > 8 And heure < 20 Then
 
           ' Transfert de l'item
             myforward.Send
 
    End If
End Sub

Voilà, si ca peu intérésser des utilisateurs du forum ^^

Reste un petit détail..... (j'ai testé avec mon email), outlook transfert 2 emails, l'original et le meme avec comme objet TR : xxxx

Peut être que quelqu'un sais pourquoi ?

Lorsque que je recois des emails alors qu'outlook est fermé, si je l'ouvre ensuite, les emails que j'ai recu pendant mon "absence" ne sont pas traité, (l'évènement ne correspond pas), y'a t'il un évènement pour ca ?

[snips67]

Et voilà, j'ai enfin trouvé, enfin finit
fiou =)

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
Private Sub Application_NewMailex(ByVal EntryIDCollection As String)
 
    'Déclarations
    Dim MonApp As Outlook.Application
    Dim MonMail As Object
    Dim MonNameSpace As Outlook.NameSpace
    Dim email As Outlook.MailItem
 
    'Instance des objets
    Set MonApp = Outlook.Application
    Set MonNameSpace = MonApp.GetNamespace("MAPI")
    Set MonMail = Application.Session.GetItemFromID(EntryIDCollection)
 
    'Dim folder As String
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
 
    'Procedure de transfert du message
 
'recupere le nombre de mail dans la boite de reception, le nombre d'item est égual a l'index du dernier mail recu
longueur = myfolder.Items.Count
 
'recupere le dernier email
Set myitem = myfolder.Items(longueur)
 
'recupere l'heure et les minutes de reception de l'email
heure = Mid(myitem.ReceivedTime, 12, 2)
 
 'création de l'email à envoyer
 Dim ol As New Outlook.Application
 Set ol = New Outlook.Application
 Dim olmail As MailItem
 Set olmail = ol.CreateItem(olMailItem)
 
    'sauvegarde temporairement la piece jointe a transferer
    Dim chemin As String
    chemin = "P:\Commun\Julien\xxxx.pdf"
 
 
     'Test si l'expéditeur et l'heure correspondent dans ce cas on déplace le mail
    If myitem.SenderEmailAddress = "xxxx@gmail.com" And heure > 8 And heure < 20 Then
 
        'Création de l'email
         myitem.Attachments.Item(1).SaveAsFile chemin
        'Caractéristiques de l'e-mail
        With olmail
        'destinataire
        olmail.To = "xxxx@gmail.com"
        'Sujet
        .Subject = myitem.Subject
        'Body
        .Body = myitem.Body
        'Pièces jointes
        .Attachments.Add chemin
        .Send
        End With
 
    'supprime la piece jointe temporaire
    Kill chemin
 
    End If
End Sub