Discussion :

[guigui1976]

Bonjour, suite à la "perte" d'un de mes dossier, je recherche un outil pour retrouver le dossier.
J'ai trouvé ceci
https://www.developpez.net/forums/d1...iers-chiffres/

mais, j'ai une erreur "with".

Comment puis je faire pour retrouver mon petit, j'ai déjà regardé dans le dossier suprimé etc... mais rien n'y fait.

Bonne journée

[guigui1976]

ou si vous avez une solution de listing avec l'arborescence de tout les fichiers, je suis preneur.
je continue de chercher.
Je vous remercie

guigui1976

[guigui1976]

je viens de trouver ceci , à voir si cela fonctionne chez un user autre que moi.

https://www.extendoffice.com/documen...r-by-name.html

Sub FindFolderByName()
Dim Name As String
Dim FoundFolder As Folder

Name = InputBox("Find Name:", "Search Folder")
If Len(Trim$(Name)) = 0 Then Exit Sub

Set FoundFouder = FindInFolders(Application.Session.Folders, Name)

If Not FoundFouder Is Nothing Then
If MsgBox("Activate Folder: " & vbCrLf & FoundFouder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
Set Application.ActiveExplorer.CurrentFolder = FoundFouder
End If
Else
MsgBox "Not Found", vbInformation
End If
End Sub
Function FindInFolders(TheFolders As Outlook.Folders, Name As String)
Dim SubFolder As Outlook.MAPIFolder

On Error Resume Next

Set FindInFolders = Nothing

For Each SubFolder In TheFolders
If LCase(SubFolder.Name) Like LCase(Name) Then
Set FindInFolders = SubFolder
Exit For
Else
Set FindInFolders = FindInFolders(SubFolder.Folders, Name)
If Not FindInFolders Is Nothing Then Exit For
End If
Next
End Function

[guigui1976]

pour avoir un listing complet des dossiers
https://www.extendoffice.com/documen...f-folders.html

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
Option Explicit
Sub GetFoldersList()
    On Error GoTo On_Error
 
    Dim Report As String
    Dim Folder As Outlook.Folder
 
    For Each Folder In Application.Session.Folders
        Report = Report & "---------------------------------------------------------------------------" & vbCrLf
        Call RecurseFolders(Folder, "", Report)
    Next
    Call CreateReportEmail("Outlook Folders List", Report)
 
Exiting:
    Exit Sub
On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
End Sub
Sub RecurseFolders(CurrentFolder As Outlook.Folder, TabChars, ByRef Report As String)
    Dim SubFolder As Outlook.Folder
    Dim FolderName, StoreName As String
 
    FolderName = CurrentFolder.Name
    StoreName = CurrentFolder.Store.DisplayName
 
    Report = Report & TabChars & FolderName & " (Store: " & StoreName & ")" & vbCrLf
 
    For Each SubFolder In CurrentFolder.Folders
        Call RecurseFolders(SubFolder, TabChars & vbTab, Report)
    Next SubFolder
End Sub
Sub CreateReportEmail(Title As String, Report As String)
    Dim aMail As MailItem
 
    Set aMail = Application.CreateItem(olMailItem)
 
    aMail.Subject = Title
    aMail.Body = Report
 
    aMail.Display
End Sub