طيب سيبك من المرفق
افتح وحدة نمطية جديدة وقم بتسميتها modRelinker
وادرج بها هذا الكود
Option Compare Database
Option Explicit
Public Function CheckLinks(ByVal strDBPassword As String) As Boolean
On Error GoTo CheckLinksErr
Dim tdf As TableDef
Dim strNewMDB As String
Dim fd As FileDialog
For Each tdf In CurrentDb.TableDefs
If UCase(Left(tdf.Name, 6)) <> "COMPAS" Then
If Len(tdf.Connect) > 0 And tdf.Fields.Count = 0 Then
If Len(strNewMDB) = 0 Then
Call MsgBox("ãä ÝÖáß ÇáÈÑäÇãÌ ÛíÑ ãÊÕá ÈÞÇÚÏÉ ÇáÈíÇäÇÊ ÇáÑÆíÓíÉÇáãÓãì (ÇßÊÈ ÇÓã ÇáÞÇÚÏÉ ÇáÎáÝíÉ åäÇ ÜÜ ÞÇÚÏÉ ÇáÌÏÇæá)", vbCritical, "SOFT SAMPLE -Pro.In.Out")
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.InitialFileName = CurrentDBFolder()
.Filters.Add "Access Database File (*.accdb)", "*.accdb", 1
.Title = "Select Back-End Data File"
.ButtonName = "Link Tables"
If .Show = False Then
Exit Function
Else
strNewMDB = .SelectedItems(1)
End If
End With
End If
If (IsNull(strDBPassword) = True) Or (strDBPassword = "") Then
tdf.Connect = ";DATABASE=" & strNewMDB
Else
tdf.Connect = ";DATABASE=" & strNewMDB & ";PWD=" & strDBPassword
End If
tdf.RefreshLink
End If
End If
Next tdf
CheckLinks = True
CheckLinksDone:
Exit Function
CheckLinksErr:
MsgBox "Error #" & err.Number & ": " & err.Description, vbCritical
Resume CheckLinksDone
End Function
Public Function CurrentDBFolder() As String
Dim strPath As String
strPath = CurrentDb.Name
Do While Right$(strPath, 1) <> "\"
strPath = Left$(strPath, Len(strPath) - 1)
Loop
CurrentDBFolder = strPath
End Function
وفى النموذج الافتتاحى فى بداية البرنامج ضع الكود التالى
Private Sub Form_Close()
On Error Resume Next
If CheckLinks("admin") = False Then
Call Quit
End If
Dim tdfs As DAO.TableDefs
Dim tdf As TableDef
Dim sSourceDB As String
Dim sBackupDB As String
Dim backDBName As String
Set tdfs = CurrentDb.TableDefs
Set tdf = tdfs(tdfs.Count - 1)
sSourceDB = Right(tdf.Connect, Len(tdf.Connect) - 10)
backDBName = Dir(mID(tdf.Connect, 11))
sBackupDB = mID(tdf.Connect, 11, Len(tdf.Connect) - (Len(backDBName) + 10)) '
DoCmd.OpenForm "LNK_TBL_DLG"
DoCmd.Close acForm, Me.Name
End Sub
وقم بعمل كلمة سر لقاعدة البيانات الخلفية باسم admin