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

[محمد سلامة]

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

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

تحياتي 🌹

[طلب اكسس]

انظر لهذ

 

[bumb]

  في 17‏/8‏/2021 at 13:51, طلب اكسس said:

انظر لهذ

 

Expand  

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

[طلب اكسس]

  في 17‏/8‏/2021 at 13:54, bumb said:

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

Expand  

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

[محمد سلامة]

  في 17‏/8‏/2021 at 13:51, طلب اكسس said:

انظر لهذ

 

Expand  

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

[د.كاف يار]

  في 17‏/8‏/2021 at 13:47, محمد سلامة said:

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

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

تحياتي 🌹

Expand  

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

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

[محمد سلامة]

  في 17‏/8‏/2021 at 16:20, د.كاف يار said:

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

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

Expand  

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

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

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

 

[محمد سلامة]

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