Discussion :

[Fredjo71]

Bonjour à tous,

Suite à des problèmes de synchronisation d'une boite partagée (et au fait que le (super sympa!!) support de microsoft n'aie pu m'aider), j'ai migré tout le dossier "archives" dans un fichier .pst... en pensant bêtement que je pourrais recopier les fichiers de la même façon dans l'autre sens.... mais si l'option "copier vers" était disponible dans ce sens, copier du fichier .pst vers le compte mail n'est pas possible !!
Je me retrouve donc avec des 100taines de dossiers à déplacer manuellement, un par un... autant dire mission impossible certains dossiers comprennent des 100taines de mails... ça prend donc du temps . BREF.

J'ai trouvé sur le net comment deleter tous les sous dossiers d'un dossier parent (ça fonctionne très bien)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Delete_All_SubFolders()
Dim oCurrFolder As Folder
Dim oSubFolders As Folders
Dim i As Long
 
On Error Resume Next
 
Set oCurrFolder = Outlook.Application.ActiveExplorer.CurrentFolder
Set oSubFolders = oCurrFolder.Folders
 
For i = oSubFolders.Count To 1 Step -1
oSubFolders.Item(i).Delete
Next
End Sub

Il me semblait qu'un MoveTo en place du Delete pourrait fonctionner également mais je n'y parviens pas.
A noter que mes compétences en VBA sont proches du zéro, si j'arrive à comprendre ce que le code existant fait, lorsque je veux le modifier, je suis paumé très vite..

Pourtant, je suis certain que ce n'est pas complexe pour ...vous

Il s'agit donc, pour votre meilleure visualisation, de déplacer les répertoires de mon archive .pst "archives_gembloux" à ma boite "archives gembloux".



Merci d'avance pour votre aide !!!

[Fredjo71]

Moi qui croyait que c'était simple à faire, après 50 affichages pas de réponse... aie

[Oliv-]

Bonjour,
Il faut utiliser la fonction "importer"

dans le menu fichier/ouvrir

[Fredjo71]

Bonjour Oliv,

Oui, bien entendu cela fonctionne, mais je voudrais pouvoir faire une macro pour déplacer vraiment les fichiers.. Cela doit être faisable non ?

Merci encore !

[Oliv-]

Bonjour,
Oui ça l'est, il faut tester si le dossier à copier existe, s'il n'existe pas on peut copier le dossier complet directement, s'il existe il faut copier item par item.


là un exemple :

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
Option Explicit
Public myNewFolder As Outlook.MAPIFolder
Public Tour As Double
Public olApp As Object
 
 
 
Sub Copie_vers_autres_bal()
    Dim objFolder As Outlook.MAPIFolder
    Dim strFileName As String
    Dim strDisplayName As String
    Dim objNS As Namespace
    Dim qCreatePST, go
 
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
 
    MsgBox "selectionnez le dossier SOURCE"
    Set objFolder = objNS.PickFolder
 
        MsgBox "selectionnez le dossier DESTINATION"
        Set myNewFolder = objNS.PickFolder
 
 
 
 
 
    If MsgBox("Etes vous sûr de vouloir copier les éléments des dossiers et sous-dossiers de " & vbCr & objFolder.Name & vbCr & " vers " & vbCr & myNewFolder.Name, vbYesNo, "Confirmation") = vbNo Then Exit Sub
 
    ProcessFolderCopy objFolder
    MsgBox "Terminé"
End Sub
 
Sub ProcessFolderCopy(StartFolder As Outlook.MAPIFolder)
    Dim destFolder As Outlook.Folder
    Dim myItem
    Dim myCopiedItem
 
    Tour = Tour + 1
    Dim objFolder As Outlook.MAPIFolder
    '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.DefaultItemType = olMailItem Then
 
        '  MsgBox StartFolder.Name
 
 
        Set destFolder = myNewFolder.Folders(StartFolder.Name)
        On Error GoTo 0
 
        If Not IsEmpty(destFolder) Then
            For Each myItem In StartFolder.Items
                If myItem.Class <> olMail And myItem.Class <> olReport Then Stop: myItem.Display
 
                Set myCopiedItem = myItem.Copy
                myCopiedItem.Move destFolder
            Next myItem
            For Each objFolder In StartFolder.Folders
                On Error GoTo 0
                Call ProcessFolderCopy(objFolder)
            Next
        Else
            On Error Resume Next
            StartFolder.CopyTo myNewFolder
            Debug.Print "copy " & StartFolder.Name & " vers " & myNewFolder.Name
        End If
    End If
 
    Exit Sub
racine:
    ' process all the subfolders of this folder
 
    For Each objFolder In StartFolder.Folders
        On Error GoTo 0
        Call ProcessFolderCopy(objFolder)
    Next
 
    Set objFolder = Nothing
End Sub

[Fredjo71]

Le code est de toi ? c'est beau

Je peux sélectionner le folder "source" et le folder "destination", il copie un mail du dossier "source".. vers le dossier "source" lui-même, puis s'arrête :
On dirait qu'il ne trouve pas le dossier "destination" :



Pourtant, il semble bien prendre en compte le folder que j'avais choisi :



Merci pour ton temps !

[Oliv-]

Il faut remplacer la ligne

Code :

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

If Not IsEmpty(destFolder) Then

par

Code :

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

  If Not IsEmpty(destFolder) And Not destFolder Is Nothing Then

le code n'est pas optimal notamment s'il existe des dossiers identiques dans le dossier de destination

[Fredjo71]

Je teste..

J'ai l'impression qu'il déplace le dossier parent alors qu'il doit juste déplacer le contenu.

Merci Oliv !

[Oliv-]

Le programme doit copier chaque dossier