OutlookFolder

[danasegarane]

Hi all,
Good Evening to All,
How can I retrive the outlook folders and their size without getting the anoying Outlook Security Prompt

Thanks in Advance
Dana

[dglienna]

Need to create a Trusted ActiveX control, or Outlook won't like it.
New changes since Windows SP2.

[danasegarane]

Dear David,
Presently I am having this code with me.How can I improve on it
Now How can I get the folder size of the Folders

Option Explicit
'Micosoft CDO 1.21 Library
'Micosoft Outlook 11.0 Object Library
'Microsoft Scripting Runtime
Dim colApp As Outlook.Application
Dim colNameSpace As Outlook.NameSpace
Dim myFolder, mySubFolder As Outlook.MAPIFolder
 Dim txt As TextStream
    Dim fso As New FileSystemObject
Private Sub Command1_Click()
  On Error Resume Next
  Set colApp = CreateObject("Outlook.Application")
  Set colNameSpace = colApp.GetNamespace("MAPI")
    Set txt = fso.OpenTextFile("C:\1.txt", ForAppending, True)
    
    For Each myFolder In colNameSpace.Folders
      For Each mySubFolder In myFolder.Folders
        ''An error will be generated if .Description was left blank
        ''when the folder was created. On Error Resume Next should be used
        ''in which case .Description will = "" probable user created folder
        'If mySubFolder.Description = "" Or InStr(1, mySubFolder.Description, "inbox", vbTextCompare) <> 0 Then
        '  If mySubFolder.DefaultItemType = olMailItem Then 'is mail folder type unknown
            Call listsubfolder(mySubFolder)
           ' List1.AddItem mySubFolder.Name
            txt.WriteLine mySubFolder.Name
           Debug.Print mySubFolder.Name
            
        '  End If
        'End If
      Next
    Next
    txt.Close
  Set colNameSpace = Nothing
  colApp.Quit
  Set colApp = Nothing
End Sub

Private Sub listsubfolder(nfolder As Outlook.MAPIFolder)
   Dim sfolder As Outlook.MAPIFolder
    For Each sfolder In nfolder.Folders
     txt.WriteLine sfolder.Name
        Call listsubfolder(sfolder)
    Next
End Sub