Microsoft KB Archive/162078

= ACC95: Using OLE Automation to Import Microsoft Exchange Message =

Article ID: 162078

Article Last Modified on 10/11/2006

-

APPLIES TO


 * Microsoft Access 95 Standard Edition

-



This article was previously published under Q162078



SUMMARY
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.



MORE INFORMATION
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:  Start Microsoft Access and create a new database.  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  Save the table as Messages.  Create a module and type the following line in the Declarations section: Option Explicit

Dim db As DATABASE Dim rsMsg As Recordset  In the References box, select OLE/Messaging 1.0 Object Library, and 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.  Type the following procedures: '======================================================================   '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 </li></ol>

Usage
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

To import messages from a top level folder folder named "InBox" in all information stores, call the procedure with "InBox" as the FolderName argument and no InfoStoreName argument:

ImportMessages "InBox"

To import messages from all top level folders of an information store named "My Info Store," call the procedure with no FolderName argument and "My Info Store" as the InfoStoreName argument:

ImportMessages, "My Info Store"

To import messages from a top level folder named "InBox" from an information store named "My Info Store", call the procedure with "InBox" as the FolderName argument and "My Info Store" as the InfoStoreName argument:

ImportMessages "InBox", "My Info Store"

<div class="references_section">