Accessing Default Folders, Non-Default Folders, SubFolders

VB Snippet

Outlook 2000 - Accessing Default Folders, Non-Default Folders, SubFolders

Default Folders - MailItems
SubFolders - MailItems
Default Folders - ContactItems
Default Folders - ContactItems - Distribution Lists
Default Folders - AppointmentItems
Non-Default Folders

Default Folders - MailItems (for 'Sent' folder, change olFolderInbox to olFolderSentMail)

Dim olApp As Outlook.Application
Dim inbox As Outlook.MAPIFolder
Dim email As Outlook.MailItem
 
Set olApp = New Outlook.Application
Set inbox = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
 
For Each email In inbox.Items
  List1.AddItem email.Subject
Next
 
Set inbox = Nothing
Set olApp = Nothing

=====================     top

SubFolders - MailItems (e.g. a subfolder to 'Inbox' called 'reviewing')

Dim olApp As Outlook.Application
Dim inbox As Outlook.MAPIFolder
Dim reviewing As Outlook.MAPIFolder
Dim email As Outlook.MailItem
 
Set olApp = New Outlook.Application
Set inbox = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set reviewing = inbox.Folders("reviewing")
 
For Each email In reviewing.Items
  List1.AddItem email.Subject
Next
 
Set reviewing = Nothing
Set inbox = Nothing
Set olApp = Nothing
 
=======================      top

Default Folders - ContactItems

Note: due to the probability of Distribution Lists within the contacts folder, it is unwise to loop in a similar fashion to MailItems.
A for/next loop of 'for each contact in contacts.items' will generate a 'type-mismatch' error on encountering any distribution list.

Dim olApp As Outlook.Application
Dim contacts As Outlook.MAPIFolder
Dim contact As Outlook.ContactItem
Dim i As Integer
 
Set olApp = New Outlook.Application
Set contacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
 
For i = 1 To contacts.Items.Count
  If TypeOf contacts.Items.Item(i) Is Outlook.ContactItem Then
    Set contact = contacts.Items.Item(i)
    List1.AddItem contact.Email1Address
  End If
Next

Set contact = Nothing
Set contacts = Nothing
Set olApp = Nothing
 
=======================      top

Default Folders - ContactItems - Distribution Lists (e.g. a distribution list name 'WorkGroup')

Dim olApp As Outlook.Application
Dim contacts As Outlook.MAPIFolder
Dim listContact As Outlook.Recipient
Dim distList As Outlook.DistListItem
Dim i As Integer
 
Set olApp = New Outlook.Application
Set contacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Set distList = contacts.Items("WorkGroup")
 
For i = 1 To distList.MemberCount
   Set listContact = distList.GetMember(i)
  List1.AddItem listContact.Address
Next
 
Set listContact = Nothing
Set distList = Nothing
Set contacts = Nothing
Set olApp = Nothing

=======================      top

Default Folders - AppointmentItems (e.g listing tomorrow's appointments)

Dim olAPP As Outlook.Application
Dim calendar As Outlook.MAPIFolder
Dim appointment As Outlook.AppointmentItem
Dim i As Integer
 
Set olAPP = New Outlook.Application
Set calendar = olAPP.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
 
For Each appointment In calendar.Items
  If DateValue(appointment.Start) <= Date + 1 And _
     DateValue(appointment.End) >= Date + 1 Then
      List1.AddItem appointment.Subject
  End If
Next
 
Set calendar = Nothing
Set olAPP = Nothing

=======================     top

Non-Default Folders (e.g. a folder called 'Jokes')

Dim olAPP As Outlook.Application
Dim personalFolder As Outlook.MAPIFolder
Dim jokes As Outlook.MAPIFolder
Dim email As Outlook.MailItem
 
Set olAPP = New Outlook.Application
Set personalFolder = olApp.GetNamespace("MAPI").Folders("Personal Folders")
Set jokes = personalFolder.Folders("jokes")
 
For Each email In jokes.Items
  List1.AddItem email.Subject
Next
 
Set jokes = Nothing
Set personalFolder = Nothing
Set olAPP = Nothing

back    top    main page    vb snippets page      java snippets page     vbscript snippets page   email    Page last modified