Public Sub basMessagingLink(Optional IsAddressBook = False)

Dim tdfDAO As TableDef
Dim strConn As String

g_strMsg = "Are you sure?" & vbCrLf _
    & "TIP: Outlook Express should not " _
    & "be your default MAPI client " _
    & "during this procedure. (In Outlook Express, " _
    & "see Options > General.)"
If VBA.MsgBox(g_strMsg, vbQuestion + vbYesNo _
    + vbDefaultButton2, _
    "Songhay System") = vbNo Then Exit Sub

On Error GoTo basMessagingLink_Err

If VBA.VarType(IsAddressBook) <> vbBoolean Then _
    If VBA.VarType(IsAddressBook) <> vbInteger Then _
        VBA.Err.Raise 450

'Source database type:
strConn = "Exchange 4.0;"
'Table name (MAPILEVEL=<storage|folders>):
strConn = strConn & "MAPILEVEL=Personal Folders|;"
'Source table type (0 for folders, 1 for address books):
If IsAddressBook Then
    strConn = strConn & "TABLETYPE=1;"
Else
    strConn = strConn & "TABLETYPE=0;"
End If
'Database name (DATABASE=<path>):
strConn = strConn & "DATABASE=" _
    & Application.CurrentDb.Name & ";"
'Profile name (optional):
strConn = strConn & "PROFILE=Windows Messaging Settings;"
'Password (optional):

If IsAddressBook Then
    Set tdfDAO = Application.CurrentDb _
        .CreateTableDef("twmAddressBook")
Else
    Set tdfDAO = Application.CurrentDb _
        .CreateTableDef("twmWebCom")
End If

With tdfDAO
    .Connect = strConn
    If IsAddressBook Then
        .SourceTableName = "Personal Address Book"
    Else
        .SourceTableName = "WebCom Accesses"
    End If
End With

With Application.CurrentDb
    .TableDefs.Append tdfDAO
    VBA.MsgBox tdfDAO.Name _
        & " has been linked to this database.", vbInformation
    .TableDefs.Refresh
End With

Application.RefreshDatabaseWindow

basMessagingLink_Exit: Exit Sub

basMessagingLink_Err: Select Case VBA.Err Case 3000 VBA.MsgBox "There is a problem with " _ & "the connection string.", vbCritical Resume basMessagingLink_Exit Case 3170 VBA.MsgBox "Windows Messaging Installable ISAM " _ & "(in Msexch32.dll) not found or not " _ & "registered.", vbCritical Resume basMessagingLink_Exit Case 3012 VBA.MsgBox tdfDAO.Name _ & " is already linked to this database.", _ vbInformation Resume basMessagingLink_Exit Case Else VBA.MsgBox VBA.Err & ": " & VBA.Err.Description, _ vbCritical, "basMessagingLink Error" Resume basMessagingLink_Exit End Select

End Sub