Question : Populate listbox with Outlook MAPI folder messages

I would like to display a listbox on my access form that displays the contents of a specified Outlook MAPI folder. How can I do this?

I currently use the code below, but I don't know how to refer to different MAPI folders.

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:

           
           
             Private Sub Form_Load()
  
    Dim iOutlook As Outlook.Application
    Dim myitem As Outlook.MailItem
    Dim myNameSpace As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim myAttach As Outlook.Attachment
    Dim DB As DAO.Database
    Set DB = CurrentDb
    Set iOutlook = New Outlook.Application
    Set myNameSpace = iOutlook.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set mynewfolder = myFolder.Folders("Inbox")
    
    DB.Execute "delete * from tblTempFaxList"
    
    For I = 1 To mynewfolder.Items.Count
        Set myitem = mynewfolder.Items(I)
        DB.Execute "INSERT INTO tblTempFaxList ( [#], [Sender], [Date], [Size], [Attachment] ) Values ( '" & I & "', '" & right(myitem.Subject, Len(myitem.Subject) - 31) & "', '" & myitem.CreationTime & "', '" & myitem.Size & "', 'xxx');"
    Next I
    
    Set myitem = Nothing
    Set myFolder = Nothing
    Set mynewfolder = Nothing
    Set iOutlook = Nothing
    
    Me.lstIncomingFaxes.Requery
    
End Sub

           
         

Open in New Window

Select All

Answer : Populate listbox with Outlook MAPI folder messages

Or you can hard-code the folder; here are some folder references to use:

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:

           
           
             	'Declare namespace and folder variables
 
	'VBS syntax
	Dim nms
	Dim fld
 
	'VBA syntax
	Dim nms As Outlook.NameSpace
	Dim fld as Outlook.MAPIFolder
 
	Set nms = Application.GetNameSpace("MAPI")
 
	'Set reference to default Calendar folder
	'VBS syntax
	Set fld = nms.GetDefaultFolder(9)
	Set fld = appOutlook.Session.GetDefaultFolder(9)
   
	'VBA syntax
	Set fld = nms.GetDefaultFolder(olFolderCalendar)
	Set fld = appOutlook.Session.GetDefaultFolder(olFolderCalendar)
 
	'Set reference to default Contacts folder
	'VBS syntax
	Set fld = nms.GetDefaultFolder(10)
	Set fld = appOutlook.Session.GetDefaultFolder(10)
 
	'VBA syntax
	Set fld = nms.GetDefaultFolder(olFolderContacts)
	Set fld = appOutlook.Session.GetDefaultFolder(olFolderContacts)
 
	'Set reference to default Deleted Items folder
	'VBS syntax
	Set fld = nms.GetDefaultFolder(3)
 
	'VBA syntax
	Set fld = nms.GetDefaultFolder(olFolderDeletedItems)
 
	'Set reference to default Drafts folder
	'VBS syntax
	Set fld = nms.GetDefaultFolder(16)
 
	'VBA syntax
	Set fld = nms.GetDefaultFolder(olFolderDrafts)
 
	'Set reference to default Inbox folder
	'VBS syntax
	Set fld = nms.GetDefaultFolder(6)
 
	'VBA syntax
	Set fld = nms.GetDefaultFolder(olFolderInbox)
 
	'Set reference to default Journal folder
	'VBS syntax
	Set fld = nms.GetDefaultFolder(11)
	Set fld = appOutlook.Session.GetDefaultFolder(11)
 
	'VBA syntax
	Set fld = nms.GetDefaultFolder(olFolderJournal)
	Set fld = appOutlook.Session.GetDefaultFolder(olFolderJournal)
 
	'Set reference to default Notes folder
	'VBS syntax
	Set fld = nms.GetDefaultFolder(12)
 
	'VBA syntax
	Set fld = nms.GetDefaultFolder(olFolderNotes)
	Set fld = appOutlook.Session.GetDefaultFolder(olFolderNotes)
 
	'Set reference to default Outbox folder
	'VBS syntax
	Set fld = nms.GetDefaultFolder(4)
	Set fld = appOutlook.Session.GetDefaultFolder(4)
 
	'VBA syntax
	Set fld = nms.GetDefaultFolder(olFolderOutbox)
	Set fld = appOutlook.Session.GetDefaultFolder(olFolderOutbox)
 
	'Set reference to default Sent Mail folder
	'VBS syntax
	Set fld = nms.GetDefaultFolder(5)
 
	'VBA syntax
	Set fld = nms.GetDefaultFolder(olFolderSentMail)
 
	'Set reference to default Tasks folder
	'VBS syntax
	Set fld = nms.GetDefaultFolder(13)
	Set fld = appOutlook.Session.GetDefaultFolder(13)
 
	'VBA syntax
	Set fld = nms.GetDefaultFolder(olFolderTasks)
	Set fld = appOutlook.Session.GetDefaultFolder(olFolderTasks)
 
	'Set reference to custom Personal folder:
 
	Set fld = nms.Folders("Personal Folders").Folders("Custom Folder")
 
	'Set reference to custom Public folder:
 
	Set fld = nms.Folders("Public Folders").Folders("All Public Folders").Folders("Custom Folder")
 
	'Display the selected folder
	fld.display
	
   'Set reference to a folder under an Exchange mailbox
   'VBA syntax
   Set objOutlook = CreateObject("Outlook.Application")
   'Set reference to Outlook Calendar folder in an Exchange mailbox
   Set nms = objOutlook.GetNamespace("MAPI")
   Set rcp = nms.CreateRecipient(strUserName)
   'strUserName must be the name of a valid recipient mailbox on
   'Exchange server
   rcp.Resolve
   If rcp.Resolved Then
       Set fld = nms.GetSharedDefaultFolder _
           (rcp, olFolderCalendar)
   Else
      MsgBox "Can't find a valid mailbox for " & strUserName _
         & "; using default local calendar"
      Set fld = nms.GetDefaultFolder(olFolderCalendar)
   End If
 
   'VBS syntax
   'Set reference to Outlook Contacts folder in an Exchange mailbox
   Set nms = Application.GetNamespace("MAPI")
   strUserName = nms.CurrentUser
   Set rcp = nms.CreateRecipient(strUserName)
   'strUserName must be the name of a valid recipient mailbox on
   'Exchange server
   rcp.Resolve
   If rcp.Resolved Then
       Set fld = nms.GetSharedDefaultFolder(rcp, 10)
   Else
      MsgBox "Can't find a valid mailbox for " & strUserName _
         & "; using default local Contacts folder"
      Set fld = nms.GetDefaultFolder(10)
   End If
           
         

Open in New Window

Select All