oui il passe dans le if
Version imprimable
oui il passe dans le if
le code marche sur la boite perso, ça va bien dans le sous dossier en attente de la boite perso
ko pour boite groupe
BONJOUR,
ta boite perso c'est LA BAL par défaut ? Parce que si c'est le cas c'est pas censé envoyer le message dans le dossier "en attente"Citation:
le code marche sur la boite perso, ça va bien dans le sous dossier en attente de la boite perso
sais tu suivre en mode pas à pas le déroulement ? pour voir ce qui cloche ?
2 fois Oui
au fait, j'ai viré les clefs de registre
1ère trace
mail envoyé de la boite perso par défaut
De: Serveur Microsoft Exchange
classement du mail envoyé dans "en attente" de la boite personnelle
pas de passage dans les cases
Code:
1
2 Item.SentOnBehalfOfNam = vide Application.Session.CurrentUser.Name = emeric
Code:
1
2 Item.SendUsingAccount.DisplayName = "Serveur Microsoft Exchange" Application.Session.DefaultStore.DisplayName = "Boîte aux lettres - emeric"
dans volet de navigation
nom de la boite partagée: apoptim
dans la zone "De:" du mail à envoyer=> apo-optimisation@domaine.fr
classement dans éléments envoyés de la boite personnelle
Code:
1
2 Item.SentOnBehalfOfNam = apoptim Application.Session.CurrentUser.Name = emeric
passage dans le 1er case
Code:
1
2
3
4
5 If Not TypeName(objFolder) = "Nothing" Then Set Item.SaveSentMessageFolder = objFolder Item.SendUsingAccount.DisplayName = "Serveur Microsoft Exchange" Application.Session.DefaultStore.DisplayName = "Boîte aux lettres - emeric"
Ok je commence à comprendre, en fait ton "COMPTE" et ton "Fichier de donnée" par défaut ont des noms différents.
Peux tu me renvoyer le résultat dans la fenetre execution avec ce code
Code:
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 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) '--------------------------------------------------------------------------------------- ' Procedure : Application_ItemSend ' Author : OLiv- ' Date : 17/05/2016 ' Purpose : '--------------------------------------------------------------------------------------- ' Dim prompt As String Dim taille, pieces Dim objNS As NameSpace Dim objFolder As MAPIFolder Set objNS = Application.GetNamespace("MAPI") ' on verifie que c'est un mail If Not Item.Class = olMail Then GoTo fin '#######ENREGISTRER UNE COPIE ET OU ####### Debug.Print "Item.SentOnBehalfOfName=" & Item.SentOnBehalfOfName Debug.Print "Application.Session.CurrentUser.Name=" & Application.Session.CurrentUser.Name Debug.Print "Item.SaveSentMessageFolder=" & Item.SaveSentMessageFolder Debug.Print "Item.SendUsingAccount.displayName=" & Item.SendUsingAccount.displayName Debug.Print "Application.Session.DefaultStore.displayName=" & Application.Session.DefaultStore.displayName If Item.SentOnBehalfOfName <> "" And Item.SentOnBehalfOfName <> Application.Session.CurrentUser.Name Then Debug.Print "IF 1" If Item.DeleteAfterSubmit = False And _ Item.SaveSentMessageFolder Like "*léments envoyés" Then On Error Resume Next Select Case Item.SentOnBehalfOfName Case objNS.Folders(Item.SentOnBehalfOfName).Name Debug.Print "Case 1" Set objFolder = objNS.Folders(Item.SentOnBehalfOfName).Folders("Boîte de réception").Folders("En attente") Debug.Print "objFolder.Name=" & objFolder.Name If TypeName(objFolder) = "Nothing" Then Set objFolder = oobjNS.Folders(Item.SentOnBehalfOfName).Folders("Boîte de réception").Folders.add("En attente") End If Case "BAL1" Debug.Print "Case 2" Set objFolder = objNS.Folders("BAL1").Folders("Boîte de réception").Folders("En attente") Case "BAL2" Debug.Print "Case 3" Set objFolder = objNS.Folders("BAL2").Folders("Boîte de réception").Folders("En attente") End Select If Not TypeName(objFolder) = "Nothing" Then Debug.Print "TypeName(objFolder) NOT Nothing avant SaveSentMessageFolder" Stop '2 Set Item.SaveSentMessageFolder = objFolder End If Set objFolder = Nothing Set objNS = Nothing End If ElseIf Item.SendUsingAccount.displayName <> Application.Session.DefaultStore.displayName Then If Item.DeleteAfterSubmit = False And _ Item.SaveSentMessageFolder Like "*léments envoyés" Then Debug.Print "ESLEIF" On Error GoTo fin Set objFolder = Item.SendUsingAccount.DeliveryStore.GetDefaultFolder(olFolderInbox).Folders("En attente") If Not TypeName(objFolder) = "Nothing" Then Debug.Print "#CHANGEMENT SaveSentMessageFolder= " & objFolder.FolderPath Set Item.SaveSentMessageFolder = objFolder End If Set objFolder = Nothing Set objNS = Nothing End If End If '#######FIN ####### fin: Set Item = Nothing End Sub
en remettant les clefs de registres ça marche !
HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Outlook\Preferences => DelegateSentItemsStyle = 1 HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Outlook\Options\Genera => DelegateWastebasketStyle = 4
il me reste à tester le code avec une boite partagée montée manuellement => j'attends qu'on me la créée et je fais un retour
le code ci-dessous ne sert à rien ?
Code:
1
2
3
4 Case "BAL1" Set objFolder = objNS.Folders("BAL1").Folders("Boîte de réception").Folders("En attente") Case "BAL2" Set objFolder = objNS.Folders("BAL2").Folders("Boîte de réception").Folders("En attente")
ca marche avec le dernier code ?
peux tu tester cela
ce devrait te renvoyer : "Serveur Microsoft Exchange"Code:MsgBox Outlook.Application.Session.Accounts.Item(1)
Donc il faudrait changer le ELSEIF
PAR
Code:ElseIf Item.SendUsingAccount.displayName <> Application.Session.Accounts.Item(1).displayName Then
c'est pour les BAL ajoutée manuellement en tant que compte
je ne vois pas ou il faut que j'ajoute le code du ElseIf.
En fait la 2ème partie du code je n'en ai pas besoin car je veux qu'un mail envoyé depuis la boite personnelle (compte mail par défaut) reste dans "Eléments envoyés"
======================================
Code:
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 Set objNS = Application.GetNamespace("MAPI") ' on verifie que c'est un mail If Not Item.Class = olMail Then GoTo fin '#######ENREGISTRER UNE COPIE ET OU ####### If Item.SentOnBehalfOfName <> "" And Item.SentOnBehalfOfName <> Application.Session.CurrentUser.Name Then 'Boite groupe If Item.DeleteAfterSubmit = False And _ Item.SaveSentMessageFolder = "Éléments envoyés" Then On Error GoTo fin Select Case Item.SentOnBehalfOfName Case objNS.Folders(Item.SentOnBehalfOfName).Name 'automatique Set objFolder = objNS.Folders(Item.SentOnBehalfOfName).Folders("Boîte de réception").Folders("En attente") Case "BAL1 en dur" Set objFolder = objNS.Folders("BAL1").Folders("Boîte de réception").Folders("En attente") If Not TypeName(objFolder) = "Nothing" Then Set Item.SaveSentMessageFolder = objFolder 'MsgBox "recoucou pour sauvegarde" End If Set objFolder = Nothing Set objNS = Nothing End If End If 'boite perso / compte mail par défaut If Item.SendUsingAccount.DisplayName <> Application.Session.DefaultStore.DisplayName Then If Item.DeleteAfterSubmit = False And _ Item.SaveSentMessageFolder Like "*léments envoyés" Then On Error GoTo fin Set objFolder = Item.SendUsingAccount.DeliveryStore.GetDefaultFolder(olFolderInbox).Folders("En attente") If Not TypeName(objFolder) = "Nothing" Then Set Item.SaveSentMessageFolder = objFolder MsgBox "recoucou 2" End If Set objFolder = Nothing Set objNS = Nothing End If End If '#######FIN ####### fin: Set Item = Nothing End Sub
je remets le bon code complet
la deuxième partie je l'ai corrigée précédemment, elle sert pour les BAL PARTAGEES créées en tant que compte.
Pour les bal en automapping il faut effectivement les clefs de registre
HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Outlook\Preferences => DelegateSentItemsStyle = 1
HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Outlook\Options\Genera => DelegateWastebasketStyle = 4
Code:
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 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) '--------------------------------------------------------------------------------------- ' Procedure : Application_ItemSend ' Author : OLiv- ' Date : 17/05/2016 ' Purpose : '--------------------------------------------------------------------------------------- ' Dim prompt As String Dim taille, pieces Dim objNS As NameSpace Dim objFolder As MAPIFolder Set objNS = Application.GetNamespace("MAPI") ' on verifie que c'est un mail If Not Item.Class = olMail Then GoTo fin '#######ENREGISTRER UNE COPIE ET OU ####### Debug.Print "Item.SentOnBehalfOfName=" & Item.SentOnBehalfOfName Debug.Print "Application.Session.CurrentUser.Name=" & Application.Session.CurrentUser.Name Debug.Print "Item.SaveSentMessageFolder=" & Item.SaveSentMessageFolder Debug.Print "Item.SendUsingAccount.displayName=" & Item.SendUsingAccount.displayName Debug.Print "Application.Session.DefaultStore.displayName=" & Application.Session.DefaultStore.displayName If Item.SentOnBehalfOfName <> "" And Item.SentOnBehalfOfName <> Application.Session.CurrentUser.Name Then 'POUR BAL GROUPE automapping Debug.Print "IF 1" If Item.DeleteAfterSubmit = False And _ Item.SaveSentMessageFolder Like "*léments envoyés" Then On Error Resume Next Select Case Item.SentOnBehalfOfName Case objNS.Folders(Item.SentOnBehalfOfName).Name Debug.Print "Case 1" Set objFolder = objNS.Folders(Item.SentOnBehalfOfName).Folders("Boîte de réception").Folders("En attente") Debug.Print "objFolder.Name=" & objFolder.Name If TypeName(objFolder) = "Nothing" Then Set objFolder = oobjNS.Folders(Item.SentOnBehalfOfName).Folders("Boîte de réception").Folders.add("En attente") End If Case "BAL1" Debug.Print "Case 2" Set objFolder = objNS.Folders("BAL1").Folders("Boîte de réception").Folders("En attente") Case "BAL2" Debug.Print "Case 3" Set objFolder = objNS.Folders("BAL2").Folders("Boîte de réception").Folders("En attente") End Select If Not TypeName(objFolder) = "Nothing" Then Debug.Print "TypeName(objFolder) NOT Nothing avant SaveSentMessageFolder" Stop '2 Set Item.SaveSentMessageFolder = objFolder End If Set objFolder = Nothing Set objNS = Nothing End If ElseIf Item.SendUsingAccount.displayName <> Application.Session.Accounts.Item(1).displayName Then ' POUR BAL GROUPE MANUELLE If Item.DeleteAfterSubmit = False And _ Item.SaveSentMessageFolder Like "*léments envoyés" Then Debug.Print "ESLEIF" On Error GoTo fin Set objFolder = Item.SendUsingAccount.DeliveryStore.GetDefaultFolder(olFolderInbox).Folders("En attente") If Not TypeName(objFolder) = "Nothing" Then Debug.Print "#CHANGEMENT SaveSentMessageFolder= " & objFolder.FolderPath Set Item.SaveSentMessageFolder = objFolder End If Set objFolder = Nothing Set objNS = Nothing End If End If '#######FIN ####### fin: Set Item = Nothing End Sub
ça y est j'ai vu le elseif => je n'avais pas regardé ton code avec le debug
j'attends mes boites mails de test pour clore le post
en fait, je pense qu'il va falloir que je distingue les boite mails montées manuellement de la manière suivante:
=> la boite personnelle (compte par défaut) => ne rien faire => classement par défaut dans Eléments envoyés de la boite perso
=> la boite groupe montée manuelle (pas le compte par défaut" => classement dans dossier "En attente" de la BG d'émission sauf si choix "Enregistrer élément envoyé dans"
je devrai m'en sortir
à suivre...
C'EST CE QUE MON CODE DOIT FAIRE !