Dynamically Create a linked Access table to Outlook inbox.

[forensicpsyguy]

I would like to modify the following code (from MS) to dynamically create a linked table to the current user's Outlook inbox. The database will have a few users, and I want to create this linked table on entry and delete the table prior to exit from the database.

Is it possible to write code to get the information needed for this procedure without user intervention? This procedure works fine as is, but I had to hardcode the necessary information. I would need to dynamically get:
-the "exchange mailbox name" for the current user
-the current path to the database (as that may change at some point
Remember, I want to delete the linked table upon exit from the form that uses it, or the database.

Function AttachMail()
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'This code requires that the following object library be referenced:
    '   Microsoft DAO 3.6 Object Library.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim db As DAO.Database
    Dim td As DAO.TableDef

    On Error GoTo ErrorHandler

    Set db = CurrentDb()
    Set td = db.CreateTableDef("tblInbox")

    'Within the following line, replace <mailbox name> with the actual
    'Exchange mailbox name created on your computer. For example:
    '   Nancy Davolio
    td.Connect = "Exchange 4.0;MAPILEVEL=Mailbox - Stephens, Sam J LT NNMC|;"
    
    'Within the following line, replace <drive\path\dbname> with the
    'actual path to the database. For example:
    '   C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb
    'This will also support UNC (for example, \\servername\share\dbname).
    td.Connect = td.Connect & "DATABASE=C:\Documents and Settings\sjstephens\My Documents\Intern Recruitment.mdb;"
    
    'Within the following line, replace <profile name> with the actual
    'name of your email profile created on your computer. For example:
    '   Microsoft Outlook
    td.Connect = td.Connect & "PROFILE=Default Outlook Profile"

    'Substitute the name of the email folder you wish to attach.
    'In this example, we will attach the Inbox folder.
    td.SourceTableName = "Inbox"

    db.TableDefs.Append td

    Application.RefreshDatabaseWindow

    MsgBox "Table Appended!"

    Exit Function

ErrorHandler:
    MsgBox "Error " & Err & " " & Error
    Exit Function
End Function

 

[traingamer]

The database will have a few users...

If they are using it concurrently I can see some potential problems.

The current path to the database (assuming that you already have it open) is available by examining the Name property of the currentdb:

    Set dbs = CurrentDb
    strCurrPathName = dbs.Name

Greg
"Personally, I am always ready to learn, although I do not always like being taught." - Winston Churchill

 

[CautionMP]

forensicpsyguy,
And here is a rough concept (little testing and no error handling) of how the get the MAPI user name. This was written in Excel 2003 and worked with an open instance of Outlook 2003.

Public Function DefaultOutlookProfile() As String
On Error Resume Next
Dim objOutlook As Object
Dim objNamespace As Object
Dim objFolder As Object
Dim blnSpawned As Boolean
Set objOutlook = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
  Set objOutlook = CreateObject("Outlook.Application")
  blnSpawned = True
End If
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
DefaultOutlookProfile = objFolder.Parent.Name

DefaultOutlookProfile_Exit:
Set objFolder = Nothing
Set objNamespace = Nothing
If blnSpawned Then
  objOutlook.Quit
End If
Set objOutlook = Nothing
End Function

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)