اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


الردود الموصى بها

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

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

تحياتي 🌹

رابط هذا التعليق
شارك

1 دقيقه مضت, bumb 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

 

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information