P
Pete
We are running an Access 2003 MDE (split Front-end/back-end) on Citrix. When
the application is launched the FE MDE is copied in the users profile area
and then opened. During the opening process a temporary database is created
containing a temporary reporting table. However I am getting an error message
as I am unable to give the user the appropriate rights they need to use this
table.
From other postings I can see that the problem is that the user does not
have the rights to give themselves rights. However, I don’t know how I can
get around this problem in these circumstances.
My code is below:
Public Sub CreateTempTables()
'*** Creates a Temporary Database and Temporary Table and Links to it ***
'*** The Name of the Temporary MDB Created is the Same as the Current Front
End (FE) Name with "Temp" Added to the End of the Name ***
Dim tdfNew As TableDef, rstRecordset As Recordset
Dim wrkDefault As Workspace
Dim dbsTemp As Database, strTempDatabase As String
Dim strTableName As String
'*** Get default Workspace ***
Set wrkDefault = DBEngine.Workspaces(0)
strTempDatabase = Left$(CurrentDb.Name, Len(CurrentDb.Name) - 4) & "
Temp.mdb"
'*** Make Sure there isn't Already a File with the Name of the New Database
***
If Dir(strTempDatabase) <> "" Then Kill strTempDatabase
'*** Create a new Temp Database ***
Set dbsTemp = wrkDefault.CreateDatabase(strTempDatabase, dbLangGeneral)
strTableName = "tmpAuditTrail"
'*** Delete the Link to the Temp Table if it Exists ***
If TableExists(strTableName) Then
CurrentDb.TableDefs.Delete strTableName
End If
'*** Create the Temp Table ***
Set tdfNew = dbsTemp.CreateTableDef(strTableName)
With tdfNew
.Fields.Append .CreateField("cUser", dbText)
.Fields.Append .CreateField("dDate", dbDate)
.Fields.Append .CreateField("Change", dbText)
.Fields.Append .CreateField("cRecordChanged", dbText)
.Fields.Append .CreateField("cUserName", dbText)
.Fields.Append .CreateField("OldValue", dbText)
.Fields.Append .CreateField("NewValue", dbText)
dbsTemp.TableDefs.Append tdfNew
End With
dbsTemp.TableDefs.Refresh
'*** Link to the Tables in the Temp MDB ***
Dim tdfLinked As TableDef
Set tdfLinked = CurrentDb.CreateTableDef(strTableName)
tdfLinked.Connect = ";DATABASE=" & strTempDatabase
tdfLinked.SourceTableName = strTableName
CurrentDb.TableDefs.Append tdfLinked
CurrentDb.TableDefs.Refresh
RefreshDatabaseWindow
'*** Assign Permissions ***
Dim cat1 As ADOX.Catalog, usr1 As ADOX.User
Dim strCurrentDB As String, strSecurityDB As String
Set cat1 = New ADOX.Catalog
Set usr1 = New ADOX.User
usr1.Name = CurrentUser
strCurrentDB = Application.CurrentProject.FullName
strSecurityDB = Application.SysCmd(acSysCmdGetWorkgroupFile)
cat1.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
& strCurrentDB & ";Jet OLEDB:System Database=" & strSecurityDB & ";User
Id=system;Password=xxx"
cat1.Users(usr1.Name).SetPermissions strTableName, adPermObjTable,
adAccessGrant, adRightFull
Set usr1 = Nothing
Set cat1 = Nothing
End Sub
Public Function TableExists(strTableName As String) As Integer
'*** Check for Existance of Table Specified ***
Dim dbsDatabase As Database, tdfTable As TableDef
On Error Resume Next
Set dbsDatabase = DBEngine(0)(0)
dbsDatabase.TableDefs.Refresh
Set tdfTable = dbsDatabase(strTableName)
'*** If Error Occurs the Tabledef Object Could not be Accessed and Therefore
***
'*** doesn't exist or user doesn't have access Due to Security Rights. ***
If Err = 0 Then
TableExists = True
Else
TableExists = False
End If
End Function
the application is launched the FE MDE is copied in the users profile area
and then opened. During the opening process a temporary database is created
containing a temporary reporting table. However I am getting an error message
as I am unable to give the user the appropriate rights they need to use this
table.
From other postings I can see that the problem is that the user does not
have the rights to give themselves rights. However, I don’t know how I can
get around this problem in these circumstances.
My code is below:
Public Sub CreateTempTables()
'*** Creates a Temporary Database and Temporary Table and Links to it ***
'*** The Name of the Temporary MDB Created is the Same as the Current Front
End (FE) Name with "Temp" Added to the End of the Name ***
Dim tdfNew As TableDef, rstRecordset As Recordset
Dim wrkDefault As Workspace
Dim dbsTemp As Database, strTempDatabase As String
Dim strTableName As String
'*** Get default Workspace ***
Set wrkDefault = DBEngine.Workspaces(0)
strTempDatabase = Left$(CurrentDb.Name, Len(CurrentDb.Name) - 4) & "
Temp.mdb"
'*** Make Sure there isn't Already a File with the Name of the New Database
***
If Dir(strTempDatabase) <> "" Then Kill strTempDatabase
'*** Create a new Temp Database ***
Set dbsTemp = wrkDefault.CreateDatabase(strTempDatabase, dbLangGeneral)
strTableName = "tmpAuditTrail"
'*** Delete the Link to the Temp Table if it Exists ***
If TableExists(strTableName) Then
CurrentDb.TableDefs.Delete strTableName
End If
'*** Create the Temp Table ***
Set tdfNew = dbsTemp.CreateTableDef(strTableName)
With tdfNew
.Fields.Append .CreateField("cUser", dbText)
.Fields.Append .CreateField("dDate", dbDate)
.Fields.Append .CreateField("Change", dbText)
.Fields.Append .CreateField("cRecordChanged", dbText)
.Fields.Append .CreateField("cUserName", dbText)
.Fields.Append .CreateField("OldValue", dbText)
.Fields.Append .CreateField("NewValue", dbText)
dbsTemp.TableDefs.Append tdfNew
End With
dbsTemp.TableDefs.Refresh
'*** Link to the Tables in the Temp MDB ***
Dim tdfLinked As TableDef
Set tdfLinked = CurrentDb.CreateTableDef(strTableName)
tdfLinked.Connect = ";DATABASE=" & strTempDatabase
tdfLinked.SourceTableName = strTableName
CurrentDb.TableDefs.Append tdfLinked
CurrentDb.TableDefs.Refresh
RefreshDatabaseWindow
'*** Assign Permissions ***
Dim cat1 As ADOX.Catalog, usr1 As ADOX.User
Dim strCurrentDB As String, strSecurityDB As String
Set cat1 = New ADOX.Catalog
Set usr1 = New ADOX.User
usr1.Name = CurrentUser
strCurrentDB = Application.CurrentProject.FullName
strSecurityDB = Application.SysCmd(acSysCmdGetWorkgroupFile)
cat1.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
& strCurrentDB & ";Jet OLEDB:System Database=" & strSecurityDB & ";User
Id=system;Password=xxx"
cat1.Users(usr1.Name).SetPermissions strTableName, adPermObjTable,
adAccessGrant, adRightFull
Set usr1 = Nothing
Set cat1 = Nothing
End Sub
Public Function TableExists(strTableName As String) As Integer
'*** Check for Existance of Table Specified ***
Dim dbsDatabase As Database, tdfTable As TableDef
On Error Resume Next
Set dbsDatabase = DBEngine(0)(0)
dbsDatabase.TableDefs.Refresh
Set tdfTable = dbsDatabase(strTableName)
'*** If Error Occurs the Tabledef Object Could not be Accessed and Therefore
***
'*** doesn't exist or user doesn't have access Due to Security Rights. ***
If Err = 0 Then
TableExists = True
Else
TableExists = False
End If
End Function