المساعدة فى تعديل كود تحديد المسار

[محمود حاتم احمد]

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

Private Sub Command0_Click()
On Error GoTo MyErr

Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, CopyMyDB
adad = CurrentProject.Path & "\Blocks_be.accdb"
OldFile = adad
DBwithEXT = Dir(OldFile)
DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)

NewFile = CurrentProject.Path & "\backup\" & "Blocks_be-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-ss-AMPM.") & Right(DBwithEXT, 5)
CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"
Shell CopyMyDB, 0

MyErr:
If Err.Number <> 0 Then
MsgBox Err.Number & " - " & Err.Description
End Sub
 لعمل نسخة احطياطية للقاعدة المشكلة التى لدى عند تحيد المسار من  برتشن اخر لايعمل يجب ان يكون قريب من الملف  مثل d: 

[husamwahab]

السلام عليكم استاذ محمود حاتم احمد

تفسير الكود ان خزن النسخة الاحتياطية يتم في فولدر backup 

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

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

On Error GoTo MyErr

Dim strFilePath As String
  strFilePath = CurrentProject.Path & "\backup"

Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, CopyMyDB
adad = CurrentProject.Path & "\Blocks_be.accdb"
OldFile = adad
DBwithEXT = Dir(OldFile)
DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)

  If Len(Dir(strFilePath, vbDirectory)) = 0 Then
    MkDir strFilePath
    SetAttr strFilePath, vbNormal
  End If
  
NewFile = strFilePath & "\Blocks_be-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-ss-AMPM.") & Right(DBwithEXT, 5)
CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"
Shell CopyMyDB, 0

MyErr:
If Err.Number <> 0 Then
MsgBox Err.Number & " - " & Err.Description
End If

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

وهذا كود الطريقة الثانية علما ان الحفظ سيتم في c في فولدر backup

On Error GoTo MyErr

Dim strFilePath As String
  strFilePath = "C:\backup"

Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, CopyMyDB
adad = CurrentProject.Path & "\Blocks_be.accdb"
OldFile = adad
DBwithEXT = Dir(OldFile)
DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)

  If Len(Dir(strFilePath, vbDirectory)) = 0 Then
    MkDir strFilePath
    SetAttr strFilePath, vbNormal
  End If
  
NewFile = strFilePath & "\Blocks_be-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-ss-AMPM.") & Right(DBwithEXT, 5)
CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"
Shell CopyMyDB, 0

MyErr:
If Err.Number <> 0 Then
MsgBox Err.Number & " - " & Err.Description
End If

وعذرا للاطالة

 

[محمود حاتم احمد]

شكرا اخي هجرب الطريقة

[ابو جودي]

3 دقائق مضت, محمود حاتم احمد said:

شكرا اخي هجرب الطريقة

حاول ترفق مثال ليتم التعديل عليه مباشرة اسهل لك فى الفهم 

[محمود حاتم احمد]

مثال انا القاعدة عندى على برتشن الشبكة z:/  والبرنامج على برتشن d:/ انا كنت عاوز البرنامج يعمل نسخة احطياتية من قاعدة الشبكة ويحطها فى ملف على البرتشن d:   انا حاليا  اطريت اخلى البرنامج على نفس برتشن الشبكة فى جهازى فقط وانقل النسخ الاحطياتية منول وبطريقة الاخ حسام استطعت تفادى طريقة النقل منول وعذرا للاطالة

A.accdb

[محمود حاتم احمد]

عدلت على طريقة الاخ حسام  ووصلت للمطلوب 

On Error GoTo MyErr
Dim strFilePath As String
Dim strFilePath2 As String
  strFilePath = "d:\mahmoud\data work\backup"
  strFilePath2 = "z:\Blocks_be.accdb"
Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, CopyMyDB
adad = strFilePath2
OldFile = adad
DBwithEXT = Dir(OldFile)
DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)

  If Len(Dir(strFilePath, vbDirectory)) = 0 Then
    MkDir strFilePath
    SetAttr strFilePath, vbNormal
  End If
  
NewFile = strFilePath & "\Blocks_be-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-ss-AMPM.") & Right(DBwithEXT, 5)
CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"
Shell CopyMyDB, 0

MyErr:
If Err.Number <> 0 Then
MsgBox Err.Number & " - " & Err.Description
End If

وشكرا جزيلا لكم على المساعدة الاكثر من رائعة 

[ابو جودي]

5 ساعات مضت, محمود حاتم احمد said:

عدلت على طريقة الاخ حسام  ووصلت للمطلوب 

 

اعرف ان استاذى الجليل الاستاذ @husamwahab ما قصر بطرح الحل ووضعه على اكمل وجه 

ولكن كان قصدى ارفاق القاعدة له فوائد جمه

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

2- يسهل على من يريد مساعدتك فهم طلبك بوضوح والتكيف اولا مع آلية التصميم والتعامل بعد ذلك معه بوضع الحل المناسب بالآلية التى تتماشى معه 

 

[أبو ماجد الغامدي]

في ٣٠‏/١١‏/٢٠٢٠ at 00:29, ابا جودى said:

حاول ترفق مثال ليتم التعديل عليه مباشرة اسهل لك فى الفهم 

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

اخي ابا جودي ممكن الخاص الله يحفظك

[محمود حاتم احمد]

تمام اخي أبا جودي