Cherche un folder dans les Folder de OutLook

Version imprimable

Bonjour tou le monde.

Je suis un peu bloqué sur une petite procedure mais je pense que cela doit faire appel à la récursivité et je suis pas fort.......
Je dois parcourir le folder d'un OutLook. En fonction des utilisateurs c'est plus ou moins bien range.
Je dois trouver un folder qui a un nom précis que je connais. Mais pour l'instant avec mon code je ne lis que le deuxième niveau, apparement.

Voici mon code actuel :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub RangementDesMails() Dim outlookApp As New Outlook.Application Dim olNs As Outlook.NameSpace Dim FldrError, FldrTraite As Outlook.MAPIFolder Dim Fldr As Outlook.MAPIFolder Dim olMail As MailItem Set olNs = outlookApp.GetNamespace("MAPI") For Each Fldr In olNs.Folders MsgBox Fldr.Name If Fldr.Name = "EVENTBSH" Then MsgBox Fldr.Items.Count End If Next
J'ai mis des MSGBOX juste pour faire un truc dans mes tests, après j'aurais des vrais traitements à la place.
Pour l'instant ce qui m'intéresse c'est de pouvoir trouver ce folder et aussi m'assurer que c'est le seul qui s'appelle comme ça.

Merci pour votre aide.

Bonjour,
je propose

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
 
Global n as long
 
Sub RangementDesMails()
  Dim outlookApp As New Outlook.Application
  Dim olNs As Outlook.NameSpace
  Dim FldrError, FldrTraite As Outlook.MAPIFolder
  Dim Fldr As Outlook.MAPIFolder
  Dim olMail As MailItem
 
  Set olNs = outlookApp.GetNamespace("MAPI")
  n=0
  Set Fldr = olNs.Folders("Dossiers personnels")
  Call SousDossier(Fldr)
  if n>0 then MsgBox ("Dossier trouvé " & n & " fois")
 
End Sub
 
Sub SousDossier(Fldr)
    Dim Fld As Outlook.MAPIFolder
 
    For Each Fld In Fldr.Folders
        If Fld.Name = "EVENTBSH" Then
           n=n+1
        Else
           If Fld.Folders.Count > 0 Then Call SousDossier(Fld)
        End If
    Next Fld
End Sub

j'ai testé, cela fonctionne même si je pense qu'il y a mieux.
ne pas oublier le n global

04/08/2017, 12h05
zooffy

Merci beaucoup pour ton aide.

Je m'aperçois que j'ai oublié un detail ou plutôt que je me suis mal exprimé.
Ta mtohde parmeche très bien, j'ai jsute été oblige d'adapter deux choses :
- le Global, ça marche moyen en VBA, du coup je l'ai passé en Public
- le folder de depart marche pas parce qu'on est en anglais ici, j'ai mis ça à la place : Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Parent. ça me permet d'être sûr de partir de la racine des gens, peu importe ce qu'ils ont bricolé dans leur OutLook.

Donc merci beaucoup pour ta method, amis du coup, ça ne réponds pas tout à fait à mon besoin.
Je vais préciser : je souhaite trouver un folder précis et le premier que je trouve je le colle dans la variable Fldr. Et ensuite je dois verifier s'il y a des sous folder de celui ci portant un nom précis et s'ils n'y sont pas, je les créée.
du coup, je n'arrive pas à interrompre ta method au bon moment apparement.

MErci pour ton aide.

Bonjour,
correction apportée

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
 
Global ok As Boolean
Global s() As String
Global dossierATrouver
Global DossierACreer
 
Sub RangementDesMails()
  Dim outlookApp As New Outlook.Application
  Dim olNs As Outlook.NameSpace
  Dim FldrError, FldrTraite As Outlook.MAPIFolder
  Dim Fldr As Outlook.MAPIFolder
  Dim fld As Outlook.MAPIFolder
  Dim olMail As MailItem
 
  dossierATrouver = "EVENTBSH"
  DossierACreer = "NomSousDossier"
 
  Set olNs = outlookApp.GetNamespace("MAPI")
  ok = False
  Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Parent
  Call SousDossier(Fldr)
 
  If ok Then
    n = 2
    Set fld = olNs.Folders(s(n))
 
    Do Until fld.Name = dossierATrouver
        n = n + 1
        Set fld = fld.Folders(s(n))
    Loop
    fld.Folders.Add DossierACreer
  End If
 
End Sub
 
Sub SousDossier(Fldr)
    Dim fld As Outlook.MAPIFolder
    If Not ok Then
        For Each fld In Fldr.Folders
            If fld.Name = dossierATrouver Then
                ok = True
                s = Split(fld.FullFolderPath, "\")
            Else
                If fld.Folders.Count > 0 Then Call SousDossier(fld)
            End If
        Next fld
    End If
End Sub

Cela fonctionne, lors de la recherche du dossier, je récupère le chemin que j'éclate dans un tableau s() d'où le Split
Je reconstitue le chemin avec la boucle Do...Loop pour sélectionner le dossier trouvé
puis j'ajoute un sous dossier

complément

J'ai modifié la dernière partie qui teste si le sous-dossier à créer n'existe pas déjà

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
 
If ok Then    'dossier trouvé
    n = 2
    Set fld = olNs.Folders(s(n))
    'sélection du dossier trouvé
    Do Until fld.Name = dossierATrouver
        n = n + 1
        Set fld = fld.Folders(s(n))
    Loop
 
    'le dossier à créer existe-t-il aussi?
    ok = False
    If fld.Folders.Count > 0 Then   'il y a des sous-dossiers
        For i = 1 To fld.Folders.Count
            If fld.Folders(i).Name = DossierACreer Then
                ok = True   'on autorise pas la creation du sous-dossier car existant
            End If
        Next i
 
    Else    'pas de sous-dossier, on autorise la creation du sous-dossier
        ok = False
    End If
 
    If Not ok Then fld.Folders.Add DossierACreer    'creation du dossier
  End If

07/08/2017, 09h20
zooffy

Merci beaucoup pour ton aide, c'est génial.

Mais en fait, j'ai eu une mauvaise surprise Vendredi soir en testant la chose. Et cette surprise vient de la gestion des boites OutLook que je ne connaissais pas en interne, je suis un peu tout neuf dans la socitété.
Lorsque l'on fait cela :

Code:

Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Parent

On part de la fameuse "Inbox" qui est présente de manière certaine et on remonte à son parent qui est en general exprimé par le l'adresse mail de reception de la boite concernée. Jusque là, tout va bien.
Mais ici, dans ma société on a interdit aux utilisateurs de créer des sous folder dans cette boite (et on me l'a pas dis !!!), du coup, je peux pas le faire.

Par contre les utilisateurs ont autant de boites qu'ils veulent au meme niveau que le parent de INBOX. Sauf que je trouve pas le moyen d'y aller. J'ai réusi à comprendre qu'en fait il s'agit de fichiers PST différents qui peuvent être posé n'importe où sur le disque ou même sur un partage réseau. Et maintenant je me pose la question suivante :
- est ce qu'il y a un parent à tout ça ?
- doit on trouvé un moyen de faire la liste de ces boites pour les travailler les une après les autres et sortir au moment où on trouve le folder recherché et surtout, comment on change de boite dans le code ?

Désolé de cette péripétie, mais là, je suis coincé.

Merci pour ton aide et bon Lundi

Bonjour,
La liste des boites s'affiche puis je sélectionne la derniere
le code est a adapter.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Dim outlookApp As New Outlook.Application
  Dim olNs As Outlook.NameSpace
  Dim Fldr As Outlook.MAPIFolder
  Dim s As String
 
  Set olNs = outlookApp.GetNamespace("MAPI")
  Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Parent
 
  'Liste des boites
  n = Fldr.Parent.Folders.Count          'nombre de boites
  s = "Boites : " & vbCrLf
  For i = 1 To n
    s = s & i & " " & Fldr.Parent.Folders(i).Name & vbCrLf
  Next i
  MsgBox (s)
 
  'sélection d'une boite
  Set Fldr = Fldr.Parent.Folders(n)

08/08/2017, 10h09
zooffy

Merci beaucoup pour ton aide.

Petite adaptation du code et zou, tout roule nickel.

Tu me sors d'un très mauvais pas.
Merci et bonne journée.