my code is sick

my code is sick

Post by eye of the tige » Fri, 11 Jul 2003 01:49:09

Hi, I am having a little trouble with this code, I am new
to CDO programming but need to run an application that
will navigate through all public folders including nested
trees etc and display via a msgbox (for now) all the names
of these folders. I have read sue's book and wasn't
impressed.  If anyone can analyse the below code and tell
me what it is I am doing wrong and how to fix it I thank
you in advance. cheers

Option Explicit
Dim objfolder As folder
'Dim objApp As Outlook.Application

Dim x As Object

Sub test3()

Dim objSession As New MAPI.session
'Set objApp = CreateObject("Outlook.Application")

'Set objFolder = objApp.ActiveExplorer.CurrentFolder

objSession.Logon "", "", False, False, 0
Call TestDrv_Util_ListFolders
End Sub

Function TestDrv_Util_ListFolders()
    On Error GoTo error_olemsg
    If objfolder Is Nothing Then
        MsgBox "Must select a folder object; see Session
        Exit Function
    End If

    If CdoFolder = objfolder.Class Then
        x = Util_ListFolders(objfolder) ' use current
global folder
    End If
    Exit Function

    MsgBox "Error " & str(Err) & ": " & Error$(Err)
    Resume Next

End Function

' Function: Util_ListFolders
' Purpose: Recursively list all folders below the current
' See documentation topic: Folders collection
Function Util_ListFolders(objParentFolder As Object)

Dim objFoldersColl As Folders ' the child Folders
Dim objOneSubfolder As folder ' a single Folder object

    On Error GoTo error_olemsg

    If Not objParentFolder Is Nothing Then
        MsgBox ("Folder name = " & objParentFolder.Name)
        Set objFoldersColl = objParentFolder.Folders

        If Not objFoldersColl Is Nothing Then ' loop
through all
            Set objOneSubfolder = objFoldersColl.GetFirst
            While Not objOneSubfolder Is Nothing
                x = Util_ListFolders(objOneSubfolder)
                Set objOneSubfolder =
        End If
    End If
    Exit Function

    MsgBox "Error " & str(Err) & ": " & Error$(Err)
    Resume Next
End Function



I am trying to make as many people as I can aware of the astonishing results
that online backups and proper application of Service Packs has had on many
Exchange Servers. It is recommended  best practice that gives you all of the
peace of mind known to Exchange Administrators which is strengthening the
end user experience and helping it recover from many different error
conditions. These conditions include mailstore corruption, hardware failure,
operator error, fire, theft, flooding and server abduction by aliens,.Etc.
Best of all, there is a 100% pay-rise guarantee. For more information,
please see

2. Multiple Domains

3. Sick and tired of error: Id no: 80004005

4. CDO in VBscript question

5. Exchange Server and S/MIME

6. Rapidly losing sick space

7. Event 191 by ESE97

8. Sick Private Info Store - H E L P !


10. Sick and tired of error: Id no: 80004005

11. Sans Sick !!!

12. Changing the Zip Code Label to read Postal Code