" كود " نسخ جداول القاعدة الرئيسة من على الشبكة

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

هذا سؤال:من الأخ الكريم/ سالم-1111

اذا كانت الجداول في قاعدة بيانات اخرى هل من طريقة لنسخها

حيث كما تعرف انة عند استخدام الاكسس على الشبكة تكون الجداول مفصولة عن

الواجهة ولك جزيل الاحترام

الجواب :

ضع الكود التالي في "حدث عند النقر" لزر موضوع على نموذج غير مرتبط مع أي جدول :-

Private Sub BackUp_Click()
On Error GoTo Err_Backup
Dim strSource As String, strDest As String
Dim strError As String
'
BeginBackup:
  
  DoCmd.Hourglass True
        
  ' مسار القاعدة الرئيسة التي يوجد بها الجداول

  strSource = "D:\backup\Backend.mdb"
    
  '  مسار المجلد الذي سيتم حفظ نسخة القاعدة الإحتياطية بداخله
 strSource = "C:\YourFolderName\YourBackend.mdb"
        
  FileCopy strSource, strDest
  DoCmd.Hourglass False
  
  MsgBox ".تم بنجاح نسخ جداول القاعدة", _
    vbInformation + vbMsgBoxRight + vbOKOnly, _
    "إكتمال عملية النسخ"

Exit_Backup:
  Exit Sub

Err_Backup:
  Select Case Err.Number
    Case 61
      strError = "The Floppy Disk is full, Cannot Save to this Disk." _
        & vbCrLf & vbCrLf & "Insert a New Disk then Click ""OK"""
      If MsgBox(strError, vbCritical + vbOKCancel, " Disk Full") = vbOK Then
        Resume BeginBackup
      Else
        Resume Exit_Backup
      End If
    Case 70
      strError = "The File is currently open." & vbCrLf & _
        "The File can not be Backed Up at this time."
      MsgBox strError, vbCritical + vbOKCancel, " File Open"
    Case 71
      strError = "There Is No Disk in Drive" & vbCrLf & vbCrLf & _
        "Please Insert Disk then Click ""OK"""
      If MsgBox(strError, vbCritical + vbOKCancel, " No Disk") = vbOK Then
        Resume BeginBackup
      Else
        DoCmd.Hourglass False
        Resume Exit_Backup
      End If
    Case Else
      DoCmd.Hourglass False
      MsgBox Err.Number & vbCrLf & Err.Description
      Resume Exit_Backup
  End Select

End Sub

backup.rar