Knowledge Base

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

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"

REFERENCES

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:

153311 ACC: Using Automation to Send a Microsoft Exchange Message

Additional query words: mail

Keywords: kbinfo kbinterop kbprogramming KB162078

Microsoft KB Archive/162078

Contents