Mails envoyés provenant d'un public folder à rediriger vers celui-ci

**Oliv-** · 16/04/2014, 16h01

Est ce que sous "Medical Information Request"
il y a bien un dossier éléments envoyés ou sent ?

Essaye ce code

Code :

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

1
2
3
4
5
6
7
Sub Publicfolder()
    Set myNamespace = Application.GetNamespace("MAPI")
    Set myPublicFolder = myNamespace.GetDefaultFolder(olPublicFoldersAllPublicFolders).folder("Public Folders - MonEmail@masociete.com").folder("Medical Information Request")
    If Not myPublicFolder Is Nothing Then
        MsgBox myPublicFolder.Name
    End If
End Sub

ou celui-ci

Code :

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

1
2
3
4
5
6
7
Sub Publicfolder1()
    Set myNamespace = Application.GetNamespace("MAPI")
    Set myPublicFolder = myNamespace.GetDefaultFolder(olPublicFoldersAllPublicFolders).folder("Medical Information Request")
    If Not myPublicFolder Is Nothing Then
        MsgBox myPublicFolder.Name
    End If
End Sub

**tetsunochin** · 16/04/2014, 17h31

Non il n'y a pas de sous-dossier sent. Je voudrais que les mail envoyés arrivent dans le dossier principal.

les codes que tu proposes, je les mets à la place d'une certaine partie ou je ne mets que ça?

**Oliv-** · 17/04/2014, 09h11

SAlut,

Essaye ce 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

 
Private WithEvents objSentItems As Items
Public DestinationFolder As Outlook.Folder
 
 
Public Sub Application_Startup() ' faire F5 su ce code pour initialiser ou fermer/réouvrir outlook
'Retrieve ID for accessing non-default sent folder
    getPublicFolderID("Medical Information Request")
    Set objSentItems = Application.Session.GetDefaultFolder(olFolderSentMail).Items
End Sub
 
 
Sub getPublicFolderID(Name)
   Dim myNamespace
   Set myNamespace = Application.GetNamespace("MAPI")
   Dim oRoot As Outlook.Folder
 
    Set DestinationFolder=myNamespace.GetDefaultFolder(olPublicFoldersAllPublicFolders).folder(Name)
    
 if DestinationFolder is nothing then 
    msgbox Name & vbcr & "pas trouvé"
End if
End Sub
 
Private Sub objSentItems_ItemAdd(ByVal Item As Object)
'Fired when something is added to personal "Sent Mail" folder
Dim MailItem As Outlook.MailItem
    If TypeOf Item Is Outlook.MailItem Then
        With Item
            Set MailItem = Application.GetNamespace("mapi").GetItemFromID(.EntryID, .Parent.StoreID)
        End With
Debug.Print MailItem.SenderName
MsgBox MailItem.SenderName
 
        If MailItem.SenderName = "Medical Information Request" Then
           If DestinationFolder Is Nothing Then getPublicFolderID("Medical Information Request")
            MailItem.Move DestinationFolder
        End If
    End If
    Set MailItem = Nothing
End Sub

**tetsunochin** · 17/04/2014, 09h21

Déjà merci pour te persévérance à résoudre mon problème, c'est super sympa !

Alors avec ton dernier code, j'ai à l'ouverture d'outlook, une erreur

run time error 438 object doesn't support this property or method

**Oliv-** · 17/04/2014, 10h10

oups j'ai du oublier le s
le problème c'est que je n'ai pas de PUBLIC FOLDER POUR TESTER.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub getPublicFolderID(Name)
   Dim myNamespace
   Set myNamespace = Application.GetNamespace("MAPI")
   Dim oRoot As Outlook.Folder
 
    Set DestinationFolder=myNamespace.GetDefaultFolder(olPublicFoldersAllPublicFolders).folders(Name)
 
 if DestinationFolder is nothing then 
    msgbox Name & vbcr & "pas trouvé"
End if
End Sub

**tetsunochin** · 17/04/2014, 10h30

MAGNIFIQUE !!!

Ca marche nickel!

Un tout tout grand merci.

Je vais abuser mais serait-il possible de ne pas avoir la boite de dialogue qui apparaît après avoir envoyé le message?

**Oliv-** · 17/04/2014, 10h36

Envoyé par tetsunochin

serait-il possible de ne pas avoir la boite de dialogue qui apparaît après avoir envoyé le message?

c'est à dire ?

tu peux supprimer la ligne "MsgBox MailItem.SenderName"

**tetsunochin** · 17/04/2014, 11h05

C'était bien ça !!

Merci

Difficulté supplémentaire...mais peut-être que j'en demande trop

Certaines personnes ont accès à différents dossiers publiques (A, B, C) et chaque fois un mail y est associé (A@masociete.com, B@masociete.com, ...)
Là j'ai un script qui me dit que si j'envoie avec l'identité de A, le mail envoyé va dans le dossier publique A.

Sait-on compléter le code pour définir que si le mail est envoyé de B, le mail envoyé sera redirigé vers le dossier public B et ainsi de suite?
Ou faut-il copier/coller le code plusieurs fois et change le A par B???

**Oliv-** · 17/04/2014, 11h13

Oui on peut, il y a quelques éléments à changer

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
 
Private WithEvents objSentItems As Items
Public DestinationFolder As Outlook.Folder
 
 
Public Sub Application_Startup() ' faire F5 su ce code pour initialiser ou fermer/réouvrir outlook
    Set objSentItems = Application.Session.GetDefaultFolder(olFolderSentMail).Items
End Sub
 
 
Sub getPublicFolderID(Name)
   Dim myNamespace
   Set myNamespace = Application.GetNamespace("MAPI")
   Dim oRoot As Outlook.Folder
 
    Set DestinationFolder=myNamespace.GetDefaultFolder(olPublicFoldersAllPublicFolders).folders(Name)
    
 if DestinationFolder is nothing then 
    msgbox Name & vbcr & "pas trouvé"
End if
End Sub
 
Private Sub objSentItems_ItemAdd(ByVal Item As Object)
'Fired when something is added to personal "Sent Mail" folder
Dim MailItem As Outlook.MailItem
    If TypeOf Item Is Outlook.MailItem Then
        With Item
            Set MailItem = Application.GetNamespace("mapi").GetItemFromID(.EntryID, .Parent.StoreID)
        End With
Debug.Print MailItem.SenderName
MsgBox MailItem.SenderName
 
        Select case MailItem.SenderName 
                 case "Medical Information Request" 
                       getPublicFolderID(MailItem.SenderName)
                       MailItem.Move DestinationFolder
                  case "TOTO" 
                       getPublicFolderID(MailItem.SenderName)
                       MailItem.Move DestinationFolder
        End select
    End If
    Set MailItem = Nothing
End Sub

C'EST LA PARTIE EN VERT QU'IL FAUT DUPLIQUER

**tetsunochin** · 17/04/2014, 12h13

Le nouveau code ne fonctionne pas.

J'ai mis ton code et j'ai changé TOTO par le nom d'un autre dossier publique.
J'ai fait un test à partir du dossier publique Medical Information Request mais le mail envoyé reste dans les sent.

**Oliv-** · 17/04/2014, 12h20

ET EN AJOUTANT TOUT EN HAUT

Code :

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

option compare text

**tetsunochin** · 17/04/2014, 12h37

non plus...

**Oliv-** · 17/04/2014, 14h44

non, c'est à dire ? c'est quoi l'erreur ?

s'il y a eu un bug dans les macros il faut soit relancer outlook,

soit lancer

Code :

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

1
2
3
Public Sub init_objSentItems() 
    Set objSentItems = Application.Session.GetDefaultFolder(olFolderSentMail).items
End Sub

OPTION COMPARE TEXT SE MET EN HAUT DU MODULE

n'hésite pas à utiliserles points d'arrêt, le pas à pas, les espions ou la fenetre variable, pour comprendre !

**tetsunochin** · 17/04/2014, 15h28

J'ai testé le code chez moi et en fait je me suis rendu compte que c'était un problème de certificat sur l'autre machine...donc le nouveau code marche en ce qui concerne le dossier publique Medical Information Request.

Par contre ça ne marche pas par rapport aux autres dossiers publiques (pas de message d'erreur mais rien ne se passe) et je pense que c'est lié au fait que pour ces dossiers là, les gens ne sont pas en "send as" mais en "send on behalf of"

Du coup j'ai essaté les deux codes ci-dessous mais sans succès.

Code :

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

1
2
3
4
 
Case "Paul Durant on behalf of TOTO"
                       getPublicFolderID (MailItem.SenderName)
                       MailItem.Move DestinationFolder

Code :

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

1
2
3
4
 
Case "Paul Durant on behalf of TOTO"
                       getPublicFolderID ("TOTO")
                       MailItem.Move DestinationFolder

Des idées?

Je ne demande qu'à apprendre mais tu fais allusions à des termes que je ne comprends même pas (points d'arrêt, le pas à pas, les espions ou la fenetre variable)

**Oliv-** · 17/04/2014, 15h56

Lis ce tuto pendant que je regarde ton pb
http://cafeine.developpez.com/access...el/debugprint/

c'est très important de connaitre ces points si tu veux progresser , c'est la base et la solution à beaucoup de questions

**Oliv-** · 17/04/2014, 16h11

Change cette partie là

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
Private Sub objSentItems_ItemAdd(ByVal Item As Object)
'Fired when something is added to personal "Sent Mail" folder
Dim MailItem As Outlook.MailItem
    If TypeOf Item Is Outlook.MailItem Then
        With Item
            Set MailItem = Application.GetNamespace("mapi").GetItemFromID(.EntryID, .Parent.StoreID)
        End With
 
Debug.Print MailItem.SenderName & "-" & MailItem.Sender.Name & "-" & MailItem.SentOnBehalfOfName
MsgBox MailItem.SenderName & "-" & MailItem.Sender.Name & "-" & MailItem.SentOnBehalfOfName
 
        Select Case MailItem.Sender.Name
                 Case "Medical Information Request"
                       getPublicFolderID (MailItem.Sender.Name)
                       MailItem.Move DestinationFolder
                  Case "toto"
                       getPublicFolderID (MailItem.Sender.Name)
                       MailItem.Move DestinationFolder
        End Select
    End If
    Set MailItem = Nothing
End Sub

Il faut juste être sûr que le nom du dossier = nom qui apparait lors de l'envoi

**tetsunochin** · 17/04/2014, 16h47

Ca fonctionne super !

Un tout tout grand merci.

Je m'en vais lire ton tuto...

Mails envoyés provenant d'un public folder à rediriger vers celui-ci

VBA Outlook

Discussions similaires

Partager

Partager