B
Brian McGuigan
I am developing an appliction in Access 2002. I need to
be able to link the Outlook Contacts folder from any
version of Outlook from 97 Onwards, so that I can write a
synchronisation routine with the contacts data in Access.
I have copied the 'LinkExchangeFolder' Function from
the 'OutlookSamples.Mdb' that comes from the 'Microsoft XP
Developers Guide'. However when I run it I get an "ERROR:
3000: Reserved Error (-5605); there is no message for this
error." when the routine attempts to append the Table to
the Database. Can anyone tell me what is going on?
Function LinkExchangeFolder(strTableName) As Boolean
' This procedure creates an Access table linked to
' the Outlook Contacts folder.
Dim dbsDatabase As DAO.Database
Dim tdfTable As DAO.TableDef
Dim strConnect As String
Dim conTemp As New ADODB.Connection
Const TABLE_EXISTS = 3012
On Error GoTo Link_Err
' Set a reference to the current database.
Set dbsDatabase = CurrentDb
' Build the connection string.
strConnect = "Exchange 4.0;MAPILEVEL=" &
GetMailboxName _
& "|;TABLETYPE=0;" & "DATABASE=" &
dbsDatabase.Name & ";"
' Create a TableDef object. The name specified for the
' TableDef object is displayed as the name of the link
' in the Database window.
Set tdfTable = dbsDatabase.CreateTableDef(strTableName)
With tdfTable
.Connect = strConnect
.SourceTableName = strTableName
End With
' Append the TableDef object to create the link.
dbsDatabase.TableDefs.Append tdfTable
' The above statement generates:
' ERROR: 3000: Reserved Error (-5605); there is no
message for this error.
LinkExchangeFolder = True
Link_End:
Exit Function
Link_Err:
' If a Contacts table already exists, find out if it is
' a linked table connected to an Exchange folder.
If Err = TABLE_EXISTS Then
If InStr(dbsDatabase.TableDefs
(strTableName).Connect, "Exchange") > 0 Then
dbsDatabase.TableDefs.Delete tdfTable.Name
Resume
Else
MsgBox "There is already a table named " _
& strTableName & " in this database that
is not " _
& "linked to an Exchange data source!"
Exit Function
End If
Else
MsgBox "Error: " & Err.Number & ": " &
Err.Description
LinkExchangeFolder = False
Resume Link_End
End If
End Function
be able to link the Outlook Contacts folder from any
version of Outlook from 97 Onwards, so that I can write a
synchronisation routine with the contacts data in Access.
I have copied the 'LinkExchangeFolder' Function from
the 'OutlookSamples.Mdb' that comes from the 'Microsoft XP
Developers Guide'. However when I run it I get an "ERROR:
3000: Reserved Error (-5605); there is no message for this
error." when the routine attempts to append the Table to
the Database. Can anyone tell me what is going on?
Function LinkExchangeFolder(strTableName) As Boolean
' This procedure creates an Access table linked to
' the Outlook Contacts folder.
Dim dbsDatabase As DAO.Database
Dim tdfTable As DAO.TableDef
Dim strConnect As String
Dim conTemp As New ADODB.Connection
Const TABLE_EXISTS = 3012
On Error GoTo Link_Err
' Set a reference to the current database.
Set dbsDatabase = CurrentDb
' Build the connection string.
strConnect = "Exchange 4.0;MAPILEVEL=" &
GetMailboxName _
& "|;TABLETYPE=0;" & "DATABASE=" &
dbsDatabase.Name & ";"
' Create a TableDef object. The name specified for the
' TableDef object is displayed as the name of the link
' in the Database window.
Set tdfTable = dbsDatabase.CreateTableDef(strTableName)
With tdfTable
.Connect = strConnect
.SourceTableName = strTableName
End With
' Append the TableDef object to create the link.
dbsDatabase.TableDefs.Append tdfTable
' The above statement generates:
' ERROR: 3000: Reserved Error (-5605); there is no
message for this error.
LinkExchangeFolder = True
Link_End:
Exit Function
Link_Err:
' If a Contacts table already exists, find out if it is
' a linked table connected to an Exchange folder.
If Err = TABLE_EXISTS Then
If InStr(dbsDatabase.TableDefs
(strTableName).Connect, "Exchange") > 0 Then
dbsDatabase.TableDefs.Delete tdfTable.Name
Resume
Else
MsgBox "There is already a table named " _
& strTableName & " in this database that
is not " _
& "linked to an Exchange data source!"
Exit Function
End If
Else
MsgBox "Error: " & Err.Number & ": " &
Err.Description
LinkExchangeFolder = False
Resume Link_End
End If
End Function