مطلوب كود قطع الاتصال بالقاعدة الخلفية

[محمد سلامة]

السلام عليكم ورحمه الله وبركاته

مطلوب كود او طريقة لقطع الاتصال بالقاعدة الخلفية في كل مرة يتم الدخول إليها من القاعدة الأمامية (البرنامج)

تحياتي 🌹

[طلب اكسس]

انظر لهذ

 

[bumb]

1 دقيقه مضت, طلب اكسس said:

انظر لهذ

 

لم اجد الحل لهذه المشكلة حتى الان

[طلب اكسس]

1 دقيقه مضت, bumb said:

لم اجد الحل لهذه المشكلة حتى الان

على العكس جدا كود الدكتور يعمل بكفآة علليه جدا جربته على اكثر من برنامج

[محمد سلامة]

1 ساعه مضت, طلب اكسس said:

انظر لهذ

 

ليس هذا هو المطلوب

[د.كاف يار]

2 ساعات مضت, محمد سلامة said:

السلام عليكم ورحمه الله وبركاته

مطلوب كود او طريقة لقطع الاتصال بالقاعدة الخلفية في كل مرة يتم الدخول إليها من القاعدة الأمامية (البرنامج)

تحياتي 🌹

هلابك اخوي محمد 

سؤال ماهي جملة الاتصال التي تستخدمها ؟؟

[محمد سلامة]

4 ساعات مضت, د.كاف يار said:

هلابك اخوي محمد 

سؤال ماهي جملة الاتصال التي تستخدمها ؟؟

اهلا وسهلا بك يا دكتور

استخدام الكود التالى فى وحدة نمطية

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(" server_database من فضلك البرنامج غير متصل بقاعدة البيانات الرئيسيةالمسمى   ", vbCritical, "SOFT.SAMPLE")
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
      With fd
        .AllowMultiSelect = False
        .InitialFileName = CurrentDBFolder()
       '.Filters.Add "Access Database File (*.accde)", "*.accde", 1
        .Filters.Add "Access Database File", "*.mdb, *.accdb, *.mde, *.accde, *.mda, *.accda"
        .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(";كلمة المرور للقاعدة الخلفية") = 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 "frm-UserLogon"
DoCmd.close acForm, Me.NAME
Make_Desktop_Shortcut
End Sub

 

[محمد سلامة]

اللهم صل وسلم وبارك على سيدنا محمد وعلى اله وصحبه وسلم