Relink Tables Between Secured & NoNSecured Databases!

[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 I want it to links the 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. What is going wrong? I have to give permissions and in the
FE? How Can I give these with VBA? (The code I use is the following)

Thanks!
'-------------------------------------------------------
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
'-------------------------------------------------------------------------