Link Tables to FrontEnd from a BackEnd Secured Database

[Stelios]

Hi,
I use the following code the "Public Sub Con" to make a connection to a
secure database named "Data.mdb" and the "Public Function CreateLinkTables"
by which each time I open the FE database it links tha tables from the
Secured Database to the FE.
When the code "DoCmd.TransferDatabase acLink, ..." in the "Public Function
CreateLinkTables" is executing I have an error 3033 that I haven't the
necessery permissions to use the object 'C:\...\Data.mdb' which is the
Secured database. I have give the user dbe.DefaultUser = "xxx" all the rights
(user and group rights). Whats is going wrong?

'-------------------------------------------------------
Option Compare Database
Option Explicit
Public dbData As Database
Public dbDataPath As String

Public Sub Con()
On Error GoTo Error

Dim dbe As PrivDBEngine
Dim wrk As Workspace
Dim dbFrontEnd As Database
Dim dbFrontEndName, dbFrontEndFullPath, dbPath, dbDataName As String
Dim LenFullPath, Lendb As Integer

' Return a reference to a new instance of the PrivDBEngine object.
Set dbe = New PrivDBEngine

Set dbFrontEnd = CurrentDb
dbFrontEndFullPath = dbFrontEnd.Name
LenFullPath = Len(dbFrontEndFullPath)
dbFrontEndName = Dir(dbFrontEndFullPath)
Lendb = Len(dbFrontEndName)
dbDataName = "Data.mdb"
dbPath = Left(dbFrontEndFullPath, LenFullPath - Lendb)
dbDataPath = dbPath & dbDataName

' Set the SystemDB property to specify the workgroup file.
dbe.SystemDB = dbPath & "SafeGuard.mdw" 'strPathToFile
dbe.DefaultUser = "xxx" 'strDefaultUser
dbe.DefaultPassword = "yyy" 'strDefaultPwd
Set wrk = dbe.Workspaces(0)

' Open the secured database.
Set dbData = wrk.OpenDatabase(dbDataPath) 'strPathToDatabase

Finish:
Exit Sub

Error:
MsgBox Err.Description & " " & Err.Number
Resume Finish
End Sub


Public Function CreateLinkTables()
On Error GoTo Error
Dim tblName As String
Dim RstBE As Recordset

Con

Set RstBE = dbData.OpenRecordset("SELECT Name " & _
"FROM MSysObjects WHERE MSysObjects.Name Not Like 'MSys*' " & _
"AND MSysObjects.Type=1", dbOpenDynaset)

RstBE.MoveFirst

Do Until RstBE.EOF
tblName = RstBE!Name
DoCmd.TransferDatabase acLink, "Microsoft Access", _
dbDataPath, acTable, tblName, tblName
CreateLinkTables = CreateLinkTables + 1
RstBE.MoveNext
Loop

Finish:
Set RstBE = Nothing
CloseBE
Exit Function

Error:
MsgBox Err.Description & " " & Err.Number
Resume Finish

End Function
'-------------------------------------------------------------------------

Thanks