النسخ الاحتياطي لقاعدة البيانات

[AliAli47]

السلام عليكم 

لدي برنامج يعمل في الشبكة المحلية قاعدة البيانات في السيرفر والبرنامج في جهاز اخر 

اريد عمل نسخ احتياطي لقاعدة البيانات عند غلق البرنامج لكن المشكل البرنامج لا يتعرف على مسار قاعدة البيانات 

المسار يأتي بهذا الشكل name-pc\name_folder\db.accdb\\

مشكلة النسخة الاحتياطية.zip

[ابو جودي]

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

غير الكود التى فى الموديول تبعا للشرح الاتى 

Function RunSub()
Dim fso                 As Object
Dim fldrname            As String
Dim fldrpath            As String
Dim MyFile, DstFile     As String
Dim Syso                As Object

Set fso = CreateObject("scripting.filesystemobject")
    fldrpath = CurrentProject.Path & "\Backup"
If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath)
MyFile ="***" & "\" & "db.accdb"
DstFile = CurrentProject.Path & "\Backup\Backup-" & Format(Now, "mm-yyyy") & ".accdb"

DBEngine.Idle

Set Syso = CreateObject("Scripting.FileSystemObject")
    Syso.copyfile MyFile, DstFile
Set Syso = Nothing
DoCmd.RunCommand acCmdExit
End Function

غير ال *** ل اسم الجهاز السيرفر او  IP  حق الجهاز السيرفر على ان يكون بهذا الشكل مثلا...

\\192.168.1.3

فيكون السطر بهذا الشكل بعد التعديل 

MyFile ="\\192.168.1.3" & "\" & "db.accdb"

وفى حالة اسم الجهاز يكون بعذا الشكل

MyFile ="\\servername" & "\" & "db.accdb"

 

[AliAli47]

7 دقائق مضت, ابا جودى said:

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

غير الكود التى فى الموديول تبعا للشرح الاتى 

Function RunSub()
Dim fso                 As Object
Dim fldrname            As String
Dim fldrpath            As String
Dim MyFile, DstFile     As String
Dim Syso                As Object

Set fso = CreateObject("scripting.filesystemobject")
    fldrpath = CurrentProject.Path & "\Backup"
If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath)
MyFile ="***" & "\" & "db.accdb"
DstFile = CurrentProject.Path & "\Backup\Backup-" & Format(Now, "mm-yyyy") & ".accdb"

DBEngine.Idle

Set Syso = CreateObject("Scripting.FileSystemObject")
    Syso.copyfile MyFile, DstFile
Set Syso = Nothing
DoCmd.RunCommand acCmdExit
End Function

غير ال *** ل اسم الجهاز السيرفر او  IP  حق الجهاز السيرفر على ان يكون بهذا الشكل مثلا...

\\192.168.1.3

فيكون السطر بهذا الشكل بعد التعديل 

MyFile ="\\192.168.1.3" & "\" & "db.accdb"

وفى حالة اسم الجهاز يكون بعذا الشكل

MyFile ="\\servername" & "\" & "db.accdb"

 

قاعدة البيانات موضوعة في مجلد يعني الكود يصبح بهذا الشكل صحيح ؟

MyFile ="\\servername" & "\" & "folder_name\db.accdb"

[ابو جودي]

3 دقائق مضت, AliAli47 said:

قاعدة البيانات موضوعة في مجلد يعني الكود يصبح بهذا الشكل صحيح ؟

MyFile ="\\servername" & "\" & "folder_name\db.accdb"

طبيعى يا افندم قاعدة البيانات فى مجلد تم عمل مشاركة له 
انظر الى الجداول المرتبطة فى قاعدة بياناتك الامامية التى تفتح منها وانظر للجداول مرتبطة بالقاعدة الخلفية عن طريقة اسم الجهاز او ال  ip

[ابو جودي]

انتظر سوف اقوم بعمل القليل من التعديلات لاضفى عليها السهولة والمرونة بالنسبة لحضرتك

[ابو جودي]

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

ملاحظة هامة لن تحتاج لتحديد مسار قاعدة البيانات الخلفية ولا لتعديل اى شئ فقط استخدم الكود الاتى ,, كذلك وضعت تقريبا شرح لكل شئ على الكود
 

'-----------------------------------------------------------'
'-----------------------------------------------------------'
'           _  +-----------officena-----------+ _           '
'          /o) |             |||||            | (o\         '
'         / /  |           @(~O^O~)@          |  \ \        '
'        ( (_  | _   ----oOo--Moh--oOo----- _ |  _) )       '
'       ((\ \) +/o)----------3ssam---------(o\+ (/ /))      '
'       (\\\ \_/ /                          \ \_/ ///)      '
'        \      /                            \      /       '
'         \____/________Mohammed Essam________\____/        '
'--25-10-2021-----------------------------------------------'
'-----------------------------------------------------------'

Option Compare Database
Option Explicit

Function RunSub()

Dim dbs                   As DAO.Database
Dim tdf                   As DAO.TableDef

Dim strPathDB             As String
Dim strNameExtensionDB    As String
Dim strNameDB             As String
Dim strExtensionDB        As String

Dim strBackupPath         As String

Dim strNewNameBackupDB    As String

Dim fso                   As Object
Dim Syso                  As Object

  Set dbs = CurrentDb()

  With dbs
    For Each tdf In .TableDefs
      'Is the table a linked table?
      If tdf.Attributes And dbAttachedODBC Or tdf.Attributes And dbAttachedTable Then
        With tdf
          'Connect property contains path of link
          strPathDB = .Properties("Connect").Value
          'Path of linked database tables
          strPathDB = Replace(strPathDB, ";DATABASE=", vbNullString)
        End With
      End If
    Next tdf
   End With
  'Backup path directory
  strBackupPath = CurrentProject.Path & "\Backup\"
  
  Set fso = CreateObject("scripting.filesystemobject")
  'Create the Backup folder if it does not exist
  If Not fso.FolderExists(strBackupPath) Then fso.createfolder (strBackupPath)
  
  'Database name with extension
  strNameExtensionDB = Right(strPathDB, Len(strPathDB) - InStrRev(strPathDB, "\"))

  'Database name without extension
  strNameDB = Left(strNameExtensionDB, InStrRev(strNameExtensionDB, ".") - 1)
  
  'extension only
  strExtensionDB = Right(strPathDB, Len(strPathDB) - InStrRev(strPathDB, "."))
  
  'New name for backup database
  strNewNameBackupDB = strNameDB & "-Backup-" & Format(Now, "mm-yyyy") & "." & strExtensionDB
  
  'Backup database save path directory
  strBackupPath = strBackupPath & strNewNameBackupDB

  DBEngine.Idle
    
    'Copy the backup database to its directory
    Set Syso = CreateObject("Scripting.FileSystemObject")
      Syso.copyfile strPathDB, strBackupPath
    Set Syso = Nothing
    
  DoCmd.RunCommand acCmdExit
End Function

 

تم تعديل أكتوبر 25, 2021 بواسطه ابا جودى

[ابو جودي]

واتفضل

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

 

 

 

frontend.mdb db.mdb

تم تعديل أكتوبر 25, 2021 بواسطه ابا جودى

[ابو جودي]

طيب بالرغم من اننى كنت انتظر الرد عن نتيجة التجربة وابداء رايكم الكريم فى الفكرة الا انه طالما تم التأشير بأفضل اجابة يبدو انها بفضل الله تعالى نالت رضاكم

وللعلم انا شخصيا الفكرة عجبتنـــــى 

[حسين العربى]