Public Folders (Outlook 2000)

[rkeating]

I have about 50 public folders (in contacts format) and I am trying to print a list of the folders. Not a list of what is in the folders, but a list of the folder names. I've exported, imported, moved, and still am clueless as to getting a list. I even tried it from the server. Can this be done?

[JohnBF]

Hmmm ... here is a not-so-quick and ugly solution, which makes a few assumptions about your setup:

First the not-very-quick part. Set up shortcuts to all these required folders in your "Public Folders, Favorites", by just dragging the required Folder from it's normal "Public Folders, All Public Folders ..." location, which in effect creates a shortcut to that Public Folder in the "Public Folders, Favorites" Folder.

Copy my code from the attachment in <post#=200296>post 200296</post#> into an Outlook VBA Module. Run the code and it will pop up a window of all folders. Double click the "Public Folders, Favorites" Folder. Hum quietly to yourself for a few minutes. A Note should be created in your Notes folder listing all the Folders in your "Public Folders, Favorites", which may include other folders than the Contacts folders. Edit the Note as required and print it (Ctrl P).

Note: I can't, so I assume you can't, use my above code to ennumerate everything in my corporation's "Public Folders, All Public Folders", because I don't have the necessary permissions to run that code against them.

Hope that someone will come up with a better solution!

[rkeating]

John,
I have managed to create a module UserForm1(Code) in VBAproject.OTM. Now, to the part "run" , Where do I find the "run" button? <grin> Did I create the module wrong. I have not created a VBA module in Outlook before. (Did I say clueless before). I am the admin, so I could run it against anything on the server, but have a copy in my folders so I don't wack the public folders.

[JohnBF]

Sorry, to be specific run the ListMailItemSubFolders routine, which calls the other procedures in that posted code. With a normal OL view, press Alt-F8 and double click that procedure, or in the VBE, click anywhere in that procedure and click the run button.

[rkeating]

John,
When I tried to run the ListMailItemSubFolders, I got a message the the BuildNoteText sub is not found. When I look at the code, the subroutine is all red. I thought it might be the '_' at the end of the line, but that is in the attachment you posted, and not knowing anymore than I do about VB, I thought I'd ask.

[JohnBF]

Sorry, can you be more specific: which subroutine is in red? Is a particular line highlighted in yellow? The "_" is the VBA symbol for a long line of code which is wrapped. Just to check, the code requires four procedures:

Sub ListMailItemSubFolders()

Private Function ListSubfolders(ByRef strNoteText As String, ByRef oFolder As MAPIFolder) As Long

Private Function BuildNoteText(ByRef strNoteText As String, ByRef oFolder As MAPIFolder, _
Optional ByVal strSelFldrName As String) As String

Private Function OpenNewNoteItem() As NoteItem

I have reattached the code as I currently run it (in case there were fixes I don't remember).

[rkeating]

Sorry, the routine in red was:

Private Function BuildNoteText(ByRef strNoteText As String, ByRef oFolder As MAPIFolder, _
Optional ByVal strSelFldrName As String) As String

There was nothing in yellow. The attachment you sent also has the same function in red. It also said when I run it that macros are disabled. To enable the macros doesn't seem as straight forward as the rest of Office (Word, Excel). I'll keep looking.

[JohnBF]

Oops, sorry, I may have overlooked something obvious. Set Tools, Macros, Security, to Low. Close OL, reopen it and make sure the code is there. If not re-enter the code in the module. Close OL, it will ask if you want to save the module, OK to that, complete the close and then reopen OL. The macro should run, if not tell me more. For long-term security, reset Tools, Macros, Security, to Medium as your future setting, which will always ask you if you want to run macros on opening. That way you at least gIve OL permission to run Macros when it asks.

[SammyB]

For some strange reason, John's attachment is double-spaced, so the lines that are continued (have an unscore _ at the end) are not correct. You can just go through and delete all of the blank lines. You also need to set your macro security to medium ( Tools | Macro | Security | Medium) exit and restart Outlook.

I'm also concerned that in your post, you are missing a space before the underscore, so I will repeat the instructions:
1) Set Outlook macro security to Medium. (see above)
2) Restart Outlook, check to make sure security is still Medium.
3) From Outlook, press <ALT> + <F11> to get to the VBA IDE.
4) Use the Insert | Module to get a code module
5) Copy the code below, paste it into Word, recopy it, and paste it into the code module. (All of that pasting gets rid of the HTML formatting)
6) Press <ALT> + <F11> to return to Outlook.
7) Use the Tools | Macro | Macros menu to run the enumMailItemSubFolders macro.
8) Select the folder and a new note will pop-up with John's information.
HTH --Sam
<pre>Option Explicit
'
Sub enumMailItemSubFolders()
Dim nsNS As NameSpace
Dim oFolder As MAPIFolder, fldrSel As MAPIFolder
Dim oItemCountNote As NoteItem
Dim lngItmCount As Long
Dim strNoteText As String

Set nsNS = Application.GetNamespace("MAPI")
Set fldrSel = nsNS.PickFolder

If Not fldrSel Is Nothing Then
Set oItemCountNote = OpenNewNoteItem ' create noteitem to hold list
lngItmCount = fldrSel.Items.Count
strNoteText = BuildNoteText(strNoteText, fldrSel, fldrSel.Name)
For Each oFolder In fldrSel.Folders
If oFolder.DefaultItemType = olMailItem And oFolder.Name <> "Deleted Items" Then
strNoteText = BuildNoteText(strNoteText, oFolder, fldrSel.Name)
lngItmCount = lngItmCount + oFolder.Items.Count
lngItmCount = lngItmCount + ListSubfolders(strNoteText, oFolder)
End If
Next
strNoteText = strNoteText & vbLf & "Total Mail Items: " & Format(lngItmCount, "#,##0")
oItemCountNote.Body = oItemCountNote.Body & strNoteText
oItemCountNote.Display
Set oFolder = Nothing
End If
Set fldrSel = Nothing
Set nsNS = Nothing
End Sub
'
Private Function ListSubfolders(ByRef strNoteText As String, ByRef oFolder As MAPIFolder) As Long
Dim oSubFolder As MAPIFolder
ListSubfolders = 0
For Each oSubFolder In oFolder.Folders
If oSubFolder.DefaultItemType = olMailItem And oSubFolder.Name <> "Deleted Items" Then
strNoteText = BuildNoteText(strNoteText, oSubFolder)
ListSubfolders = ListSubfolders + oSubFolder.Items.Count
ListSubfolders = ListSubfolders + ListSubfolders(strNoteText, oSubFolder) 'recurse folder branches
End If
Next
Set oSubFolder = Nothing
End Function
'
Private Function BuildNoteText(ByRef strNoteText As String, ByRef oFolder As MAPIFolder, _
Optional ByVal strSelFldrName As String) As String
Dim lngCount As Long
lngCount = oFolder.Folders.Count

If oFolder.Parent <> "Mapi" And oFolder.Name <> strSelFldrName Then _
strNoteText = strNoteText & oFolder.Parent.Name & ""
strNoteText = strNoteText & oFolder.Name & "; " & Format(oFolder.Items.Count, "#,##0") & " Items"
If lngCount > 0 Then strNoteText = strNoteText & "; " & Format(lngCount, "#,##0") & " Subfolders"
BuildNoteText = strNoteText & vbLf
End Function
'
Private Function OpenNewNoteItem() As NoteItem
Dim oNoteitem As NoteItem
Set oNoteitem = Outlook.Application.CreateItem(olNoteItem)
oNoteitem.Body = "Mail Item Count - listing run " & Date & " @ " & Time & vbLf & vbLf
Set OpenNewNoteItem = oNoteitem
End Function</pre>

[JohnBF]

Odd, Sam, it's not double-spaced when I open it. (You meant the code attachment post in this thread, I assume?)

[SammyB]

Very odd, since we are both running IE6! This is what I get for the text attachment for <post#=200296>post 200296</post#>:

[JohnBF]

And this is what I get ...

[SammyB]

Why are our URL's different?

[SammyB]

Your URL gives single-space, mine gives double.

[JohnBF]

Oh, <img src=/w3timages/censored.gif alt=censored border=0>. See <post#=239975>post 239975</post#> where I asked if you were looking at the code in this thread or the original? I'm looking at the code I attached in this thread, you are looking at my original post.