یک برنامه data base را میتوان در دو فایل mdb جدا کرد به نحوی که همه داده ها(tables) را بصورت back-end و اصل برنامه (queries, forms, reports, macros, modules, and shortcuts to data access pages) را به شکل Front-end ارائه کرد.
برای این کار (split) باید جدولها را Relink کرد که توضیح روش انجام این کار توسط دوستان در نمونه پست 5 اینجا هست.
حالا؛برای وضعیت محدود سازی سطح دسترسی (peremision) اشیا در FE را چکار باید کرد؟
Private Sub Form_Load()
On Error Resume Next
ChangeTableDetails
DoCmd.Close acForm, Me.FormName
End Sub
Public Function ChangeTableDetails()
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim tdfLinked As DAO.TableDef
Dim strGetCurrentLinkedPath As String
Dim strGetCurrentLinkedTableName As String
Dim intTableCounter As Integer
Dim intNumberOfTables As Integer
Const strBackendTargetDbPassword = ";PWD=plajsgbd"
On Error GoTo ErrorDetected
Set dbs = CurrentDb
dbs.TableDefs.Refresh
intNumberOfTables = dbs.TableDefs.Count
For Each tdf In dbs.TableDefs
If Nz(tdf.Connect, "") <> "" Then
'Store current linked table details
strGetCurrentLinkedTableName = tdf.Name
strGetCurrentLinkedPath = tdf.Connect
strGetCurrentLinkedPath = FindDatabasePathFr0mLinkedString(strGetCurrentLink edPath)
'Delete current linked table
DoCmd.DeleteObject acTable, tdf.Name
'Rebuild linked table from stored data
'Ensure the password is correct
Set tdfLinked = dbs.CreateTableDef(strGetCurrentLinkedTableName)
tdfLinked.Connect = strBackendTargetDbPassword & ";DATABASE=" & strGetCurrentLinkedPath
tdfLinked.SourceTableName = strGetCurrentLinkedTableName
dbs.TableDefs.Append tdfLinked
End If
intTableCounter = intTableCounter + 1
If intNumberOfTables = intTableCounter Then
GoTo ClearDownArrays
End If
Next
Exit Function
ErrorDetected:
If Err.Number = 3031 Then
MsgBox "The password supplied with the function (ChangeTableDetails) " & vbCrLf & "is incorrect for the Backend Db." & vbCrLf & vbCrLf & _
"Please provide a valid password for Const 'strTargetDbPassword'", vbExclamation, "Invalid Password Set"
Else
MsgBox Err.Number & " - " & Err.Description, vbCritical, "Unexpected error detected, update aborted"
End If
ClearDownArrays:
Set tdf = Nothing
dbs.Close
Set dbs = Nothing
End Function
Public Function FindDatabasePathFr0mLinkedString(GetLinkedString As String) As String
Dim intStartPosition As Integer
Dim intEndPosition As Integer
On Error Resume Next
intStartPosition = InStr(1, GetLinkedString, "Database=") + 9
intEndPosition = InStr(1, GetLinkedString, ".mdb") + 4
FindDatabasePathFr0mLinkedString = MID(GetLinkedString, intStartPosition, intEndPosition)
لطفاً نظرتان را بفرمائید.
پاسخ با نقل قول
نوشته شده توسط moustafa
