Envoyer et classer. Copie dans Eléments envoyés et dans un autre dossier

**goninph** · 12/01/2017, 21h45

Bonjour,

Jusqu'à ce jour j'utilisais Lotus Notes
Lors de l'envoi d'un mail je cliquai sur Envoyer et classer et mon mail se trouvait à la fois dans les éléments envoyés et dans le dossier sélectionné, LE TOP

Avec Outlook, j'ai trouvé ce code pour Envoyer et déplacer dans un dossier spécifique.
Le problème c'est que le mail envoyé n'est plus présent dans le dossier Eléments envoyés, c'est fâcheux !
Comment modifier le code ci-dessous pour qu'il laisse une copie du mail envoyé dans éléments envoyés ?

Merci pour votre aide et excellente soirée
Philippe

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
Option Explicit
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
If Not Item.Class = olMail Then GoTo fin
 
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
 
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If TypeName(objFolder) = "Nothing" Then
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderDeletedItems)
End If
Set Item.SaveSentMessageFolder = objFolder
fin:
End Sub

**goninph** · 13/01/2017, 00h00

J'ai ajouter

Code :

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

1
2
        Set MSG = Item.Copy
        MSG.Move objNS.GetDefaultFolder(olFolderSentMail) ' Copie le message dans le dossier éléments envoyés

Mais ce n'est pas correct, car j'ai effectivement une copie du message dans le dossier Eléments envoyés, mais c'est une copie du mail pas encore envoyé et il est non lu ....

Pas facile ce VBA ...

Bonne nuit

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
Option Explicit
 
'Outlook_365
'Ouvre une boite de dialogue à l'envoi du message permettant de choisir ou classer le mail.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As _
Boolean)
 
 
If Not Item.Class = olMail Then GoTo fin
 
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim MSG As Object
 
            Set objNS = Application.GetNamespace("MAPI")
            Set objFolder = objNS.PickFolder 'Pickfolder = fenêtre pour choisir le dossier. Dossier éléments envoyés = Item.SaveSentMessageFolder
 
            If TypeName(objFolder) = "Nothing" Then
 
                Set objNS = Application.GetNamespace("MAPI")
                Set objFolder = objNS.GetDefaultFolder(olFolderSentMail) 'Si annuler est classé dans éléments envoyés. Dossier supprimés = olFolderDeletedItems
 
            End If
 
        Set Item.SaveSentMessageFolder = objFolder 'Déplace le message dans le dossier choisi
        Set MSG = Item.Copy
        MSG.Move objNS.GetDefaultFolder(olFolderSentMail) ' Copie le message dans le dossier éléments envoyés
fin:
End Sub

**Oliv-** · 13/01/2017, 09h24

Bonjour,
Dans Outlook , contrairement à LOTUS ce sont de vrai Dossiers où on classe un Email, L'Email s'il est dans 2 dossiers existe donc 2 fois, (Lotus se sont des vues)

Le plus simple et sans programmation c'est de créer un "Dossier de recherche" (dans l’arborescence des dossiers, tu cliques bouton droit/ nouveau) et de l'ajouter aux favoris

Avec comme critère "créer un dossier de recherche personnalisé"
de: ton adresse Email
Parcourir: tu sélectionnes la racine de ta boite et tu coches "rechercher dans les sous-dossiers"

ensuite bouton droit sur ce dossier et "Afficher dans les favoris"

**goninph** · 13/01/2017, 19h31

Hello Oliv-

Merci pour l'info, excellent, j'ai mis un moment à trouver, une copie d'écran pour aider

Mille merci et bonne soirée
Philippe

Nouveau dossier de recherche : Tous les messages envoyés
Nom : 1.png
Affichages : 6105
Taille : 12,1 Ko

Nom : 1.png
Affichages : 6105
Taille : 12,1 Ko

Nouveau dossier de recherche : Tous les messages
Nom : 2.png
Affichages : 6080
Taille : 12,1 Ko

Envoyer et classer dans un dossier :

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
Option Explicit
 
'Outlook_365
'Ouvre une boite de dialogue à l'envoi du message permettant de choisir ou classer le mail.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As _
Boolean)
 
 
If Not Item.Class = olMail Then GoTo fin
 
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim MSG As Object
 
            Set objNS = Application.GetNamespace("MAPI")
            Set objFolder = objNS.PickFolder 'Pickfolder = fenêtre pour choisir le dossier. Dossier éléments envoyés = Item.SaveSentMessageFolder
 
            If TypeName(objFolder) = "Nothing" Then
 
                Set objNS = Application.GetNamespace("MAPI")
                Set objFolder = objNS.GetDefaultFolder(olFolderSentMail) 'Si annuler est classé dans éléments envoyés. Dossier supprimés = olFolderDeletedItems
 
            End If
 
        Set Item.SaveSentMessageFolder = objFolder 'Déplace le message dans le dossier choisi
fin:
End Sub

**goninph** · 14/01/2017, 11h03

Hello,

J'ai crié victoire trop vite, car le nouveau dossier de recherche : Tous les messages envoyés, affichent tous les messages ... Grrrrrrr

C'est tout de même incroyable que ces dossiers ne soient pas natif chez Outlook ....

Bon weekend

Philippe

**Oliv-** · 16/01/2017, 10h51

Bonjour,
C'est parce que tu n'as pas mis les bon éléments
Nom : DossierRecherche.png
Affichages : 6112
Taille : 66,3 Ko

**goninph** · 16/01/2017, 19h44

Hello,

Merci pour les copies d'écran, j'ai fait exactement comme indiqué, il y tous les envoyés, mais le problème il y a tous messages :

96 messages dans le dossiers : Tous les messages
61 message dans le dossiers : Eléments envoyés (sans les envoyés classés)
0 message dans le dossiers : Tous les envoyés

Je désespère ...., qu'as tu configuré dans les autres onglets ?

Merci pour ton aide

Philippe

**goninph** · 11/02/2017, 11h06

Bonjour,

Dans la macro ci-dessous comment faire pour présélectionner le dossier Eléments envoyés au lieu de Boite de réception ? Voir image

Merci et excellent week end

Philippe

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
Option Explicit
 
'Outlook_365
'Ouvre une boite de dialogue à l'envoi du message permettant de choisir ou classer le mail.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As _
Boolean)
 
 
If Not Item.Class = olMail Then GoTo fin
 
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim MSG As Object
 
            Set objNS = Application.GetNamespace("MAPI")
            Set objFolder = objNS.PickFolder 'Pickfolder = fenêtre pour choisir le dossier. Dossier éléments envoyés = Item.SaveSentMessageFolder
 
            If TypeName(objFolder) = "Nothing" Then
 
                Set objNS = Application.GetNamespace("MAPI")
                Set objFolder = objNS.GetDefaultFolder(olFolderSentMail) 'Si annuler est classé dans éléments envoyés. Dossier supprimés = olFolderDeletedItems
 
            End If
 
        Set Item.SaveSentMessageFolder = objFolder 'Déplace le message dans le dossier choisi
fin:
End Sub

Nom : 11-02-2017 11-04-05.png
Affichages : 6042
Taille : 17,8 Ko

**Oliv-** · 13/02/2017, 10h07

Salut,
tu veux dire que la fenêtre Pickfolder se positionne à l'ouverture sur "Elements Envoyés" ?

Il n'y a pas de paramètre pour cela il faut modifier dans les options avancées de OL le dossier de démarrage "Démarrer Outlook dans ce dossier"

Tu pourrais aussi utiliser REDEMPTION qui lui permet cela
Set rdoFolder = RDOSession.PickFolder(InitialFolder, "Please select a folder")

**goninph** · 13/02/2017, 12h36

Salut Oliv,
Tu n'as pas compris la question, lorsque j'envoie un mail, la boîte de dialogue classé sous s'affiche automatiquement ,ce que fait la macro.
Le dossier sélectionné par défaut est le dossier Boîte de réception, mais j'aimerai que ce soie le dossier Éléments envoyés, de cette façon si je ne classe pas le mail le dossier éléments envoyés et déjà présélectionné.

Merci et bonne journée Philippe

**Oliv-** · 14/02/2017, 10h38

Si si c'est bien ce que j'ai dit.

**goninph** · 15/02/2017, 19h09

Ok, super et merci
Quelle est code VBA pour sélectionner le dossier Boîte de réception lors de l'ouverture de Outlook ?

Merci et bonne soirée Philippe

**Oliv-** · 16/02/2017, 15h32

C'est compliqué !
il faut changer une valeur du registre 001e0336 sous la clef :

HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\profile-name\0a0d020000000000c000000000000046

et le contenu est un savant mélange de folderID et storeID

qui doivent dépendre du compte ...

**goninph** · 16/02/2017, 19h49

Ok et merci pour toutes vos réponses

Bonne soirée Philippe

**goninph** · 18/02/2017, 09h36

Bonjour à tous,

Sur mon PC privé OL365, la macro ci-dessous fonctionne à merveille, mais j'ai un gros problème avec OL365 sur mon PC professionnel, j'ai ajouter la macro est rien ne se passe.

C'est comme si tout était désactivé, est ce possible?
Comment vérifier si le problème est du côté PC-OL365 ou du côté de la macro ?

Milles merci et bon week end
Philippe

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
 
Option Explicit
 
'Outlook_365
'Ouvre une boite de dialogue à l'envoi du message permettant de choisir ou classer le mail.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As _
Boolean)
 
 
If Not Item.Class = olMail Then GoTo fin
 
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim MSG As Object
 
            Set objNS = Application.GetNamespace("MAPI")
            Set objFolder = objNS.PickFolder 'Pickfolder = fenêtre pour choisir le dossier. Dossier éléments envoyés = Item.SaveSentMessageFolder
 
            If TypeName(objFolder) = "Nothing" Then
 
                Set objNS = Application.GetNamespace("MAPI")
                Set objFolder = objNS.GetDefaultFolder(olFolderSentMail) 'Si annuler est classé dans éléments envoyés. Dossier supprimés = olFolderDeletedItems
 
            End If
 
        Set Item.SaveSentMessageFolder = objFolder 'Déplace le message dans le dossier choisi
fin:
End Sub

**goninph** · 19/02/2017, 08h56

Bonjour,

En fait mon employeur n'a pas activé les macros dans Outlook, incroyable

Pour que la macro fonctionne je dois la signer numériquement

J'ai trouvé comment ajouter le certificat numérique et créer le certificat

C:\Program Files (x86)\Microsoft Office\root\Office16 et SELFCERT pour créer le certificat

Problème le nom du certificat n’apparaît pas dans la signature du projet VBA, mais il est présent dans : Signer en tant que ..... voir image

Lorsque je choisi le certificat, les 2 champs indiqués ci-dessus sont complétés avec mon certificat, lorsque je ferme Outlook il me demande d’enregistrer les modifications, ce que je fais, mais lors de la réouverture, j'ai une erreur, et le champs du haut est vide. voir image

Qui peut m'aider ?

Merci et bon dimanche

Philippe

Nom : certi.png
Affichages : 5904
Taille : 9,0 Ko

Nom : certi.png
Affichages : 5904
Taille : 9,0 Ko

Nom : Ajouter un certificat VBA.png
Affichages : 5925
Taille : 136,2 Ko

**Oliv-** · 19/02/2017, 17h13

Bjr l'option des macros est elle grisėe ?
Tu peux essayer en démarrant Outlook en mode administrateur en cliquant bouton droit sur le icone

**goninph** · 19/02/2017, 17h41

Les options sont effectivement grisées et je ne suis pas administrateur, c'est pourquoi je veux signer numériquement la macro pour qu'elle soit acceptée.

Merci pour votre aide. Philippe

**Oliv-** · 20/02/2017, 09h35

Salut,
Peux tu essayer à partir d'outlook fermé, tu maintiens la touche shift enfoncée puis tu cliques bouton droit sur Outlook et tu devrais avoir "Exécuter en tant d'administrateur"

ensuite soit tu as accès soit cela te demande un mot de passe.