Je ne sais pas comment tester ton code redemption pour le lancer depuis le compte administrateur sur les comptes de mon choix. Un peu comme ce que j'ai fait pour les autres programmes.
Je ne sais pas comment tester ton code redemption pour le lancer depuis le compte administrateur sur les comptes de mon choix. Un peu comme ce que j'ai fait pour les autres programmes.
- Les meilleurs cours et tutoriels Perl et Perl 6 pour vous former ;
- FAQ Perl, Perl 6 et Perl/Tk d'entraide ;
- Les news sur la rubrique Perl ;
- S'abonner au compte Twitter de la rubrique Perl ;
- Mes tutoriels developpez.com.
Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
oui uniquement sur ton poste où tu as ton outlook de paramétré.
REDEMPTION Permet de faire cela ! DAns mon exemple j'ai pas renommé le dossier, je vais modifié le code.Quand tu fais le renommage, comment tu fais pour renommer le vrai Inbox en autre chose, vu que c'est un dossier système ?
Y a aucun risque ?
j'ai fait un test sur un pst et sur un compte exchange cela semble ok, mais je ne peux garantir qu'il n'y ai pas de raté.
pour tester le code en fait tu changes juste la valeur entre guillemets par le nom de la boite voulu .
Code : Sélectionner tout - Visualiser dans une fenêtre à part Set store = Session.Stores("mabal@toto.com")
attends que je change le code stp!
En attendant un dernier test de Redemption, même si je trouve cela dangereux, le programme de copie suivant bogue :
Si j'ai l'arborescence suivante :
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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142 Option Explicit Public myNewFolder As Outlook.MAPIFolder Public Tour As Double Sub MoveFolders() '--------------------------------------------------------------------------------------- ' Procedure : MoveFolders ' Author : Oliv ' Date : 15/02/2018 ' Purpose : '--------------------------------------------------------------------------------------- ' Dim olFolder As Outlook.Folder Dim OL As Object Dim u, i, User, UserRecip As Recipient, UserStore If UCase(Application) = "OUTLOOK" Then Set OL = Application Else Set OL = CreateObject("outlook.application") End If Dim objNS As Outlook.Namespace Dim objFolderOrigine As Outlook.MAPIFolder Dim DossiersOrigine As Variant Dim DossiersCible As Variant DossiersOrigine = Array("Mailbox", "sent Items") DossiersCible = Array(olFolderInbox, olFolderSentMail) Set objNS = OL.GetNamespace("MAPI") For u = 2 To Cells(Rows.Count, 1).End(xlUp).Row User = Cells(u, 1).Value & " " & Cells(u, 2).Value MsgBox (User) On Error Resume Next Set UserRecip = objNS.CreateRecipient(User) Set UserStore = objNS.GetSharedDefaultFolder(UserRecip, olFolderInbox).Parent.Store If UserStore Is Nothing Or IsEmpty(UserStore) Then ' Set myNewFolder = UserStore.GetDefaultFolder(olFolderInbox) ' MsgBox myNewFolder.FolderPath Debug.Print User & ": inaccessible" Else For i = 0 To UBound(DossiersOrigine) Set objFolderOrigine = UserStore.GetDefaultFolder(olFolderInbox).Parent.Folders(DossiersOrigine(i)) Set myNewFolder = UserStore.GetDefaultFolder(DossiersCible(i)) If objFolderOrigine Is Nothing Then Debug.Print DossiersOrigine(i) & ":Non trouvé dans " & objNS.GetDefaultFolder(olFolderInbox).Parent If myNewFolder Is Nothing Then Debug.Print DossiersCible(i) & ":Non trouvé dans " & objNS.DefaultStore If objFolderOrigine Is Nothing Or myNewFolder Is Nothing Then Else 'MsgBox objFolderOrigine.FolderPath & vbCr & myNewFolder.FolderPath Call ProcessFolderMove(objFolderOrigine, objFolderOrigine, myNewFolder, myNewFolder) End If Set objFolderOrigine = Nothing Set myNewFolder = Nothing Next i End If Set UserRecip = Nothing Set UserStore = Nothing Next u Set objNS = Nothing Set objFolderOrigine = Nothing Set myNewFolder = Nothing End Sub Sub ProcessFolderMove(StartFolder As Outlook.MAPIFolder, objFolderOrigine As Outlook.MAPIFolder, DestinationParentFolder As Outlook.MAPIFolder, DestinationOrigine As Outlook.MAPIFolder) Tour = Tour + 1 Dim objFolder As Outlook.MAPIFolder Dim destFolder As Outlook.MAPIFolder Dim myItem Dim n 'Dim objItem As Object On Error Resume Next ' do something specific with this folder Debug.Print StartFolder.FolderPath, StartFolder.Folders.Count, StartFolder.Items.Count Debug.Print 'on teste si on est à la racine de la BAL If InStr(3, StartFolder.FolderPath, "\") = 0 Then GoTo racine If StartFolder.FolderPath = objFolderOrigine.FolderPath Then GoTo racine If StartFolder.DefaultItemType = olMailItem Then ' MsgBox StartFolder.Name Set destFolder = DestinationParentFolder.Folders(StartFolder.Name) On Error GoTo 0 If Not IsEmpty(destFolder) And Not destFolder Is Nothing Then For Each objFolder In StartFolder.Folders On Error GoTo 0 Call ProcessFolderMove(objFolder, objFolderOrigine, destFolder, DestinationOrigine) Next For n = StartFolder.Items.Count To 1 Step -1 Set myItem = StartFolder.Items(n) 'If myItem.Class <> olMail And myItem.Class <> olReport Then Stop: myItem.Display myItem.Move destFolder Next n Debug.Print "Move " & StartFolder.FolderPath & " vers " & DestinationParentFolder.FolderPath If StartFolder.Items.Count = 0 Then StartFolder.Delete Else On Error Resume Next StartFolder.MoveTo DestinationParentFolder Debug.Print "Move " & StartFolder.FolderPath & " vers " & DestinationParentFolder.FolderPath End If End If Exit Sub racine: ' process all the subfolders of this folder For n = StartFolder.Folders.Count To 1 Step -1 Set objFolder = StartFolder.Folders(n) On Error GoTo 0 Call ProcessFolderMove(objFolder, objFolderOrigine, DestinationParentFolder, DestinationOrigine) Next n 'process items For n = StartFolder.Items.Count To 1 Step -1 Set myItem = StartFolder.Items(n) If myItem.Class <> olMail And myItem.Class <> olReport Then Stop: myItem.Display myItem.Move DestinationParentFolder Next n Set objFolder = Nothing End Sub
Mailbox
- mails
--> 111/mails
--> 222/mails
--> 333/mails
----> 444/mails
Les dossiers 333 et 444 ne sont pas déplacés, pourtant ton programme semble bien récursif !
- Les meilleurs cours et tutoriels Perl et Perl 6 pour vous former ;
- FAQ Perl, Perl 6 et Perl/Tk d'entraide ;
- Les news sur la rubrique Perl ;
- S'abonner au compte Twitter de la rubrique Perl ;
- Mes tutoriels developpez.com.
Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
peut être à cause de la ligne
A vérifier avec le listage (#15)
Code : Sélectionner tout - Visualiser dans une fenêtre à part If StartFolder.DefaultItemType = olMailItem Then
Pour le code avec REDEMPTION, les tests sur une bal exchange ne sont pas vraiment concluants, cela marche pour définir le type de dossier par défaut, pas pas pour supprimer l'ancien dossier
il faudrait creuser un peu plus.
voici le code au cas où
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 Sub ChangeDefaultCalendrierAndDelete() '--------------------------------------------------------------------------------------- ' Procedure : ChangeDefaultCalendrierAndDelete ' Author : Oliv ' Date : 20/02/2018 ' Purpose : '--------------------------------------------------------------------------------------- ' Dim Session, store, folder, FolderOld, i Const olFolderCalendar = 9 Const olFolderInbox = 6 Const olFolderSentMail = 5 Dim DossiersOrigine, DossiersCible, DossiersNouveauxNoms Dim FolderOldName Set Session = CreateObject("Redemption.RDOSession") Session.Logon ' Set store = Session.Stores("pst_vide") Set store = Session.Stores("GsNord.Paq@grassavoye.com") Err.Clear On Error Resume Next ' DossiersOrigine = Array(olFolderInbox, olFolderSentMail, olFolderCalendar) ' DossiersCible = Array("Mailbox", "send Items", "Calendrier") DossiersOrigine = Array(olFolderInbox, olFolderSentMail) DossiersCible = Array("Mailbox", "send Items") DossiersNouveauxNoms = Array("Boîte de réception", "send Items") For i = 0 To UBound(DossiersOrigine) 'does the store already have a default Calendar folder? Set FolderOld = store.GetDefaultFolder(DossiersOrigine(i)) FolderOldName = DossiersNouveauxNoms(i) If Err.Number = 0 Then 'no default Calendar folder. Check if there is a folder named "Calendrier" 'and if not, create one Err.Clear Set folder = store.IPMRootFolder.Folders(DossiersCible(i)) If (Err.Number <> 0) Or (folder Is Nothing) Then 'create a new folder Err.Clear Set folder = store.IPMRootFolder.Folders.Add(DossiersCible(i)) End If If StrComp(folder.FolderPath, FolderOld.FolderPath, vbTextCompare) <> 0 Then folder.SetAsDefaultFolder (DossiersOrigine(i)) If Err.Number = 0 Then Err.Clear On Error GoTo 0 FolderOld.Delete folder.Name = FolderOldName Else MsgBox Err & vbCr & Err.Description End If End If End If Set folder = Nothing Set FolderOld = Nothing Err.Clear Next i End Sub
Je ne sais pas comment te remercier pour le temps passé à m'aider. C'est sympa.
Pour Redemption, je crois que je vais laisser tomber. J'ai testé aussi le soft MFCMAPI, mais bon, les manipulations restent assez dangereuses.
Je vais rester sur le programme de copie plus sûr. Il faut juste que je trouve pourquoi ça bogue. Je l'utiliserai pour des boites critiques, pas pour tout le monde. ce sera déjà très bien. Encore merci.
Je vais tester ton #15
- Les meilleurs cours et tutoriels Perl et Perl 6 pour vous former ;
- FAQ Perl, Perl 6 et Perl/Tk d'entraide ;
- Les news sur la rubrique Perl ;
- S'abonner au compte Twitter de la rubrique Perl ;
- Mes tutoriels developpez.com.
Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
Voici ce que j'obtiens :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 .FolderPath .DefaultItemType .Items.Count \\xxxx yyyyy\Mailbox 0 0 \\xxxx yyyyy\Mailbox\333 0 10 \\xxxx yyyyy\Mailbox\333\444 0 1 \\xxxx yyyyy\Mailbox\555 0 1
- Les meilleurs cours et tutoriels Perl et Perl 6 pour vous former ;
- FAQ Perl, Perl 6 et Perl/Tk d'entraide ;
- Les news sur la rubrique Perl ;
- S'abonner au compte Twitter de la rubrique Perl ;
- Mes tutoriels developpez.com.
Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
Pour redemption, c'est peut être chez moi juste un problème de droits insuffisants côtè EXCHANGE...
Pour l'autre méthode en principe si le dossier 555 n'existe pas dans inbox il déplace le dossier dans inbox, si le dossier existe déjà il déplace élément/élément.
qu'a de particulier l'item contenu dans 555 ?
il faudrait suivre en pas à pas pour voir ce qu'il fait
en fait, dans Mailbox je peux avoir des mails, des dossiers de mails et des dossiers de dossiers de mails.
Le programme coppie correctement tous les mails et dossiers de mails.
Dès qu'il y a des sous dossiers, il ne se passe plus rien.
- Les meilleurs cours et tutoriels Perl et Perl 6 pour vous former ;
- FAQ Perl, Perl 6 et Perl/Tk d'entraide ;
- Les news sur la rubrique Perl ;
- S'abonner au compte Twitter de la rubrique Perl ;
- Mes tutoriels developpez.com.
Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
Après investigation, le code cherche à faire un move de \\xx yy\Mailbox\333 vers \\xx yy\Inbox alors que le dossier 333 contient un sous répertoire 444 avec des mails.
Ce qui veut dire le code ne rentre pas ici :
Le .MoveTo ne sait pas copier tout le contenu plus les sous dossiers ?
Code : Sélectionner tout - Visualiser dans une fenêtre à part If Not IsEmpty(destFolder) And Not destFolder Is Nothing Then
- Les meilleurs cours et tutoriels Perl et Perl 6 pour vous former ;
- FAQ Perl, Perl 6 et Perl/Tk d'entraide ;
- Les news sur la rubrique Perl ;
- S'abonner au compte Twitter de la rubrique Perl ;
- Mes tutoriels developpez.com.
Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
en principe il sait.
mais c'est pourquoi je demandais de vérifier 555 car pas de sous dossier
Bonsoir,
Je confirme que les dossiers contenant des sous dossiers ne sont pas copiés .
- Les meilleurs cours et tutoriels Perl et Perl 6 pour vous former ;
- FAQ Perl, Perl 6 et Perl/Tk d'entraide ;
- Les news sur la rubrique Perl ;
- S'abonner au compte Twitter de la rubrique Perl ;
- Mes tutoriels developpez.com.
Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
est ce que tu peux les déplacer "manuellement" en faisant clic droit sur le dossier et déplacer.
Moi sur certains il me met un message impossible de déplacer car le dossier peut contenir des éléments privés
Bonjour,
C'est ce que je vais faire. De toute façon, je ne ferai pas le déplacement pour toutes les boites. Ce sera au cas par cas. Donc premièrement, déplacement via un clic droit pour les dossiers et le reste via la macro.
Merci pour tes aides durant ces derniers jours. Je te tiens au courant lorsque j'aurai complétement terminé.
- Les meilleurs cours et tutoriels Perl et Perl 6 pour vous former ;
- FAQ Perl, Perl 6 et Perl/Tk d'entraide ;
- Les news sur la rubrique Perl ;
- S'abonner au compte Twitter de la rubrique Perl ;
- Mes tutoriels developpez.com.
Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
Salut,
en fait ma question c'était "est ce que cela fonctionne manuellement ?"
Selon le paramétrage des comptes chez moi l'erreur se produit ou non , si le compte où je veux faire les déplacements, est un compte Principal, cela fonctionne
si c'est un compte "secondaire" j'ai le message
la copie fait pareil.
Donc soit il faut paramétrer le compte différemment, soit il faut
traiter dossier par dossier en créant le dossier dans la destination et en déplaçant item par item ,cela fonctionne.
Tous les comptes que je vais migrer sont des comptes principaux et pourtant la copie ne se fait pas.
Mais bon, j'ai la solution qui me suffira. Si je repère un dossier contenant des sous dossier, copier à la main. Et pour le reste macro.
- Les meilleurs cours et tutoriels Perl et Perl 6 pour vous former ;
- FAQ Perl, Perl 6 et Perl/Tk d'entraide ;
- Les news sur la rubrique Perl ;
- S'abonner au compte Twitter de la rubrique Perl ;
- Mes tutoriels developpez.com.
Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
Oliv pour l'aide. Toute ma messagerie (plus d'1To de données de mails) a été migrée avec beaucoup de soucis liés au logiciel de migration de merde que l'on a acheté. Néanmoins, les macros m'ont permis de corriger pas mal de souci.
- Les meilleurs cours et tutoriels Perl et Perl 6 pour vous former ;
- FAQ Perl, Perl 6 et Perl/Tk d'entraide ;
- Les news sur la rubrique Perl ;
- S'abonner au compte Twitter de la rubrique Perl ;
- Mes tutoriels developpez.com.
Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
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