یک برنامه 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)


لطفاً نظرتان را بفرمائید.