ID: Q162078
The information in this article applies to:
Advanced: Requires expert coding, interoperability, and multiuser skills.
Microsoft Access provides the SendObject method, which enables you to send a mail message through Microsoft Exchange. However, Microsoft Access provides no way to import messages from Microsoft Exchange. This article demonstrates how to use OLE Automation to import messages from Microsoft Exchange into a Microsoft Access database.
This article assumes that you are familiar with Visual Basic for Applications and with creating Microsoft Access applications using the programming tools provided with Microsoft Access. For more information about Visual Basic for Applications, please refer to the "Building Applications with Microsoft Access for Windows 95" manual.
NOTE: This article uses Microsoft Exchange, a product which must be purchased and installed separately. The Microsoft Exchange component which ships with Windows 95 will not work with this article.
The Microsoft Exchange object model provides information stores (InfoStores) that may contain multiple folders. An information store may consist of a user's Personal Information Store (.PST file), network stores, and Public Folders. Each folder in an information store may contain multiple messages. This procedure demonstrates how to import messages from top level folders of a specific information store or all information stores.
To import messages from Microsoft Exchange, follow these steps:
1. Start Microsoft Access and create a new database.
2. Create a new table with the following fields:
Table: Messages
-----------------------
Field Name: MessageID
Data Type: Text
Field Size: 255
Field Name: InfoStore
Data Type: Text
Field Size: 255
Field Name: FolderName
Data Type: Text
Field Size: 255
Field Name: Sender
Data Type: Text
Field Size: 255
Field Name: To
Data Type: Memo
Field Name: CC
Data Type: Memo
Field Name: BCC
Data Type: Memo
Field Name: Subject
Data Type: Memo
Field Name: MessageText
Date Type: Memo
Field Name: DateReceived
Date Type: Date/Time
Field Name: DateSent
Date Type: Date/Time
Field Name: Importance
Data Type: Text
Field Size: 50
4. Create a module and type the following line in the Declarations section:
Option Explicit
Dim db As DATABASE
Dim rsMsg As Recordset
click OK.
NOTE: If this object library is not available in the References list,
you will need to browse your Windows\System folder for the file
Mdisp32.tlb.
'======================================================================
'FUNCTION: ParseRecipients
'
' Purpose: Check a MAPI message for a specific type of recipient and
' return a semicolon delimited list of recipients. For instance, if
' this function is called using the MapiTo constant, this function
' will return a semicolon delimited list of all recipients on the
' 'TO' line of the message.
'======================================================================
Function ParseRecipients(objMessage As Object, RecipientType As _
Integer)
Dim RecipientCount As Long
Dim Recipient As Object
Dim ReturnString As String
Set Recipient = objMessage.Recipients(RecipientCount)
For RecipientCount = 1 To objMessage.Recipients.Count
If RecipientType = Recipient(RecipientCount).Type Then
ReturnString = ReturnString & Recipient(RecipientCount).Name _
& "; "
End If
Next
If Len(ReturnString) > 0 Then
ReturnString = Left(Trim(ReturnString), Len(ReturnString) - 2)
ParseRecipients = ReturnString
Else
ParseRecipients = Null
End If
End Function
'======================================================================
'SUB: WriteMessage
'
'Purpose: Adds message information to fields in the table through the
'the recordset opened in the ImportMessages Sub. This procedure
'is called from the RetrieveMessage Sub when it is time to write
'information to the table.
'======================================================================
Sub WriteMessage(objMessage As Object, FolderName As String, _
InfoStore As String)
Dim RetVal
Dim iString As String
iString = "Importing messages from: " & InfoStore & "\" & FolderName _
& "..."
RetVal = SysCmd(acSysCmdSetStatus, iString)
With rsMsg
.AddNew
!MessageID = objMessage.ID
!InfoStore = InfoStore
!FolderName = FolderName
!Sender = objMessage.Sender.Name
!To = ParseRecipients(objMessage, mapiTo)
!CC = ParseRecipients(objMessage, mapiCc)
!BCC = ParseRecipients(objMessage, mapiBcc)
On Error Resume Next
!subject = objMessage.subject
If Err.Number <> 0 Then
!subject = Null
Err.Clear
End If
!MessageText = objMessage.Text
If Err.Number <> 0 Then
!MessageText = Null
Err.Clear
End If
!DateReceived = objMessage.TimeReceived
If Err.Number <> 0 Then
!DateReceived = Null
Err.Clear
End If
!DateSent = objMessage.TimeSent
If Err.Number <> 0 Then
!DateSent = Null
Err.Clear
End If
!importance = Switch(objMessage.importance = 0, "Low", _
objMessage.importance = 1, "Normal", _
objMessage.importance = 2, "High")
.UPDATE
End With
End Sub
'======================================================================
'SUB: RetrieveMessage
'
'Purpose: Loop through the Messages collection of each Folder of the
'specified information store(s) and calls the WriteMessage Sub
'to write individual messages to the table. This procedure is
'called by the ImportMessages Sub.
'======================================================================
Sub RetrieveMessage(objInfoStore As Object, FolderName As Variant)
Dim objFoldersColl As Object, objFolder As Object
Dim objMessage As Object, objMessageColl As Object
'Set a Variable equal to the Folders Collection of the InfoStore's
'Top Level Folder. (RootFolder)
Set objFoldersColl = objInfoStore.RootFolder.Folders
With objFoldersColl
Set objFolder = .GetFirst
'Loop through each folder and determine if we're looking for a
'specific folder from which we're importing messages, or all
'folders.
Do While Not objFolder Is Nothing
If IsMissing(FolderName) Then
Set objMessageColl = objFolder.Messages
With objMessageColl
Set objMessage = .GetFirst
Do While Not objMessage Is Nothing
Call WriteMessage(objMessage, objFolder.Name, _
objInfoStore.Name)
Set objMessage = .GetNext
Loop
End With
Set objFolder = .GetNext
Else
If objFolder.Name = FolderName Then
Set objMessageColl = objFolder.Messages
With objMessageColl
Set objMessage = .GetFirst
Do While Not objMessage Is Nothing
Call WriteMessage(objMessage, objFolder.Name, _
objInfoStore.Name)
Set objMessage = .GetNext
Loop
End With
Exit Do
Else
Set objFolder = .GetNext
End If
End If
Loop
End With
End Sub
'======================================================================
'SUB: ImportMessage
'
'Purpose: Opens a MAPI session through OLE automation and opens a
'recordset based on the Messages table. Then, this procedure
'checks to see if it needs to import messages from top level
'folders in ALL information stores, or just a specific
'information store. Based upon this, the procedure will call
'the RetrieveMessage sub for the specified information stores.
'======================================================================
Sub ImportMessages(Optional FolderName As Variant, _
Optional InfoStoreName As Variant)
Dim objMapi As Object
Dim objFoldersColl As Object
Dim objInfoStore As Object
Dim RetVal
DoCmd.Hourglass True
Set db = CurrentDb
Set rsMsg = db.OpenRecordset("Messages", dbOpenDynaset)
RetVal = SysCmd(acSysCmdSetStatus, "Establishing MAPI Session...")
Set objMapi = CreateObject("Mapi.Session")
RetVal = SysCmd(acSysCmdSetStatus, "Logging on to MAPI Session...")
'In the following line, replace the ProfileName argument with a valid
'profile. If you omit the ProfileName argument, Microsoft Exchange
'will prompt you for your profile.
objMapi.Logon ProfileName:="Nancy Davolio"
'Loop through each InfoStore in the MAPI session and determine if we
'should read in messages from ALL InfoStores or just a specified
'InfoStore. InfoStores include a user's personal store files
'(.PST Files), Network stores, and Public Folders.
For Each objInfoStore In objMapi.InfoStores
If Not IsMissing(InfoStoreName) Then
If objInfoStore.Name = InfoStoreName Then
Call RetrieveMessage(objInfoStore, FolderName)
Exit For
End If
Else
Call RetrieveMessage(objInfoStore, FolderName)
End If
Next
objMapi.Logoff ' Log out of the MAPI session.
Set objMapi = Nothing
db.Close ' Close the Database.
Set db = Nothing
DoCmd.Hourglass False
RetVal = SysCmd(acSysCmdClearStatus)
End Sub
The ImportMessages procedure accepts two optional arguments, Foldername and InfoStoreName. This enables the user to import messages from only a specified folder in any information store, or messages from all top level folders in either in any information store.
To import messages from all top level folders of all information stores, call the procedure with no arguments:
ImportMessages
ImportMessages "InBox"
ImportMessages , "My Info Store"
ImportMessages "InBox", "My Info Store"
For more information about OLE Automation, search on the phrase "OLE Automation," and then view "Using Microsoft Access as an OLE Automation Controller" using the Answer Wizard from the Microsoft Access for Windows 95 Help menu.
For more information about referencing object libraries, search on the phrase "referencing object libraries," and then view "setting references" using the Answer Wizard from the Microsoft Access for Windows 95 Help menu.
For more information about using OLE Automation with Microsoft Exchange, please see the following article in the Microsoft Knowledge Base:
ARTICLE-ID: Q153311
TITLE : ACC: Using Automation to Send a Microsoft Exchange Message
Keywords : kbinterop kbole IntpOlea
Version : 7.0
Platform : WINDOWS
Hardware : x86
Issue type : kbinfoLast Reviewed: June 12, 1998