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"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 VB : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Item.SentOnBehalfOfNam = vide Application.Session.CurrentUser.Name = emeric
Code VB : Sélectionner tout - Visualiser dans une fenêtre à part
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 VB : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Item.SentOnBehalfOfNam = apoptim Application.Session.CurrentUser.Name = emeric
passage dans le 1er case
Code VB : Sélectionner tout - Visualiser dans une fenêtre à part
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 : 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
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 VB : Sélectionner tout - Visualiser dans une fenêtre à part
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 : Sélectionner tout - Visualiser dans une fenêtre à part MsgBox Outlook.Application.Session.Accounts.Item(1)
Donc il faudrait changer le ELSEIF
PAR
Code : Sélectionner tout - Visualiser dans une fenêtre à part 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 VB : 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 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 : 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
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 !
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager