Folder Madness

[Kovenna]

Hi there,

I have built up a tree of hundreds of folders under my "InBox".
I'm now finding it next to impossible to find stuff by folder now because there does not appear to be a method of finding folders in Outlook as opposed to emails etc.

Is it possible to set up a search function whereby I type in say "Attix5 Setup" and it finds the folder and sets the focus to it, wherever it is buried within the tree?

Many thanks

[SamT]

See if this will help you
Jacob' VBA Tip #4 - Outlook Email Organization (http://www.vbaexpress.com/forum/entry.php?49-Jacob-VBA-Tip-4-Outlook-Email-Organization)

[Kovenna]

Thanks Sam,

Phew - quite a bit of code to wade through. I'll check it out :rotlaugh:

[Charlize]

Kovenna,

Tried several things but for now, this one is the only one that more of less can find a folder based on a searchstring (partial even).

The pickfolder routine I was trying at first, doesn't give a possibility to define a folder to be highlighted by default.

Anyway, here the code that finds a subfolder based on a searchstring.

Sub Get_Sub_Folders()
'declare some variables to use
Dim myinbox As Folder, mynofolders As Long, myfoldername As String
Dim foldersfound As Long, storefolder As String
'set your inbox to myinbox
Set myinbox = Application.Session.GetDefaultFolder(olFolderInbox)
'set variable to zero
foldersfound = 0
'display number of subfolders of myinbox = your default inbox
MsgBox myinbox.Folders.Count
'give a searchstring, can be partial but needs to give unique folder
myfoldername = InputBox("Give name ...", "Get folder ...")
'loop through subfolders of inbox
For mynofolders = 1 To myinbox.Folders.Count
'compare given searchstring with foldername
'if string is found then it must be greater than zero
If InStr(1, myinbox.Folders(mynofolders).Name, myfoldername) > 0 Then
'add 1 to foldersfound = to know if only one folders was found
'with searchstring
foldersfound = foldersfound + 1
'display messagebox
MsgBox "Folder <<< " & myinbox.Folders(mynofolders).Name & _
" >>> located with search : " & myfoldername
'store the name of the folder you found in a variable
storefolder = myinbox.Folders(mynofolders).Name
Else
'if searchstring isn't found in the subfolder name, display mesage
MsgBox myfoldername & " <> " & myinbox.Folders(mynofolders).Name
End If
'loop through all the subfolders of inbox
Next mynofolders
'if only one folder was found with searchstring, you found the folder
If foldersfound = 1 Then
MsgBox "Save to " & storefolder
Else
'if more, you need to give another searchstring to find a unique folder
MsgBox "More folders found with searchstring : " & myfoldername
End If
End Sub
Charlize

[Kovenna]

Hi Charlize,

Thanks for this. I created the module and it works as designed, so thank you very much for this.
However, I need to tweak it to do the following:

1. List all the results at one go, rather than having to click "ok" to see the next dialog
2. Show all the preceding folders back up to Inbox

For example, I asked for folders called "Meetings" - I think there are about 15 of them lol so I had to plough through each dialog noting them down.

The results screen needs to look like this as an example:

Inbox->Project 1->Meetings
Inbox->Manager->HR->Meetings
Inbox->Assignments->Local Govt->Halton BC->Meetings

etc etc

This then would be seriously helpful.

Obviously, I can hunt around and try and amend this myself now that you kindly got me started, but if you have any thoughts on how I might achieve the above, please let me know ;-)

Anyway, thanks once again

[Kovenna]

Hmmm. Actually, working through it line by line in the code its doesn't work lol
Just finds 20 folders under Inbox, then throws up 20 found dialogs even if not true. Chuckle.
I'm trying to correct it now...

[Kovenna]

Worked the problem and I think this is the answer - works a treat:


Sub CountAllFolders()
Dim MyArray() As String
ReDim MyArray(1)
Dim MySearch As String
Dim numfolders, numsubfolders As Long
Dim ArrayElem As Integer

ArrayElem = 1
MySearch = InputBox("Enter the text to Search for", "Find folders")
Set myNameSpace = Application.GetNamespace("MAPI")
Set myinbox = myNameSpace.GetDefaultFolder(olFolderInbox)
'------------------------------------------------------------------------------------------------------
For num1folders = 1 To myinbox.Folders.Count
'Debug.Print "* " & myinbox.Folders(num1folders).Name
If InStr(1, myinbox.Folders(num1folders).Name, MySearch) > 0 Then
ReDim Preserve MyArray(UBound(MyArray) + 1)
MyArray(ArrayElem) = "Inbox\" & myinbox.Folders(num1folders).Name
'Debug.Print MyArray(ArrayElem)
ArrayElem = ArrayElem + 1
End If
'-------------------------------------------
Set Sub1Folder = myinbox.Folders(num1folders)
For num2folders = 1 To Sub1Folder.Folders.Count
'Debug.Print " -> " & Sub1Folder.Folders(num2folders).Name
If InStr(1, Sub1Folder.Folders(num2folders).Name, MySearch) > 0 Then
ReDim Preserve MyArray(UBound(MyArray) + 1)
MyArray(ArrayElem) = "Inbox\" & myinbox.Folders(num1folders).Name & "\" & Sub1Folder.Folders(num2folders).Name
'Debug.Print MyArray(ArrayElem)
ArrayElem = ArrayElem + 1
End If
'-------------------------------------------
Set sub2folder = Sub1Folder.Folders(num2folders)
For num3folders = 1 To sub2folder.Folders.Count
'Debug.Print " -> " & sub2folder.Folders(num3folders).Name
If InStr(1, sub2folder.Folders(num3folders).Name, MySearch) > 0 Then
ReDim Preserve MyArray(UBound(MyArray) + 1)
MyArray(ArrayElem) = "Inbox\" & myinbox.Folders(num1folders).Name & "\" & Sub1Folder.Folders(num2folders).Name & "\" & sub2folder.Folders(num3folders).Name
'Debug.Print MyArray(ArrayElem)
ArrayElem = ArrayElem + 1
End If
'---------------------------------------
Set sub3folder = sub2folder.Folders(num3folders)
For num4folders = 1 To sub3folder.Folders.Count
'Debug.Print " ->" & sub3folder.Folders(num4folders).Name
If InStr(1, sub3folder.Folders(num4folders).Name, MySearch) > 0 Then
ReDim Preserve MyArray(UBound(MyArray) + 1)
MyArray(ArrayElem) = "Inbox\" & myinbox.Folders(num1folders).Name & "\" & Sub1Folder.Folders(num2folders).Name & "\" & sub2folder.Folders(num3folders).Name & "\" & sub3folder.Folders(num3folders).Name
'Debug.Print MyArray(ArrayElem)
ArrayElem = ArrayElem + 1
End If
'---------------------------------------
Next num4folders
Next num3folders
Next num2folders
Next num1folders
'--------------------------------------------------------------------
' Now display the list
'--------------------------------------------------------------------
For i = LBound(MyArray) To UBound(MyArray)
msg = msg & MyArray(i) & vbNewLine
Next i
MsgBox "The folders with '" & MySearch & "' in them are:" & vbNewLine & msg
End Sub