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

[jafar089]

لقد عملت برنامج للنسخ الاحتياطي به 3 أزرار حيث أن كل زر يتم حفظ النسخة الاحتياطية في مكان مختلف .

المطلوب / أن يتم عمل زر واحد فقط للنسخ الاحتياطي يحفظ القاعدة في ثلاثة أماكن متفرغة .

وهذا هو كود النسخ المراد التعديل عليه :

Private Sub Backup_Click()

Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, CopyMyDB

OldFile = CurrentDb.Name

DBwithEXT = Dir(OldFile)

DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)

NewFile = "c:\mybackup" & "\" & DBwithoutEXT & Right(DBwithEXT, 4)

CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"

Shell CopyMyDB, 0

MyErr:

If Err.Number <> 0 Then

MsgBox Err.Number & " - " & Err.Description

End If

Call Shell("regedit.exe /s """ & CurrentProject.Path & "\Enable.reg""", 0)

MsgBox "تم نسخ قاعدة البيانات بنجاح ..", vbOKOnly, "تم النسخ بنجاح"

End Sub

db1.rar

[ابوخليل]

تم التعديل

يتم النسخ الى ثلاث مواقع بزر واحد

Private Sub Backup_Click()

Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, NewFile2, NewFile3, CopyMyDB

OldFile = CurrentDb.Name

DBwithEXT = Dir(OldFile)

DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)

NewFile = "c:\mybackup" & "\" & DBwithoutEXT & Right(DBwithEXT, 4)

NewFile2 = "d:\mybackup" & "\" & DBwithoutEXT & Right(DBwithEXT, 4)

NewFile3 = "f:\mybackup" & "\" & DBwithoutEXT & Right(DBwithEXT, 4)

CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"

CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile2 & """"

CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile3 & """"

Shell CopyMyDB, 0

MyErr:

If Err.Number <> 0 Then

MsgBox Err.Number & " - " & Err.Description

End If

Call Shell("regedit.exe /s """ & CurrentProject.Path & "\Enable.reg""", 0)

MsgBox "تم نسخ قاعدة البيانات بنجاح ..", vbOKOnly, "تم النسخ بنجاح"

End Sub

[jafar089]

مشكوور كثيرا على الإجابة ..

ولكن الكود ينفذ فقط آخر مكان وهو على القرص f .

وقد وجدت الحل بتكرار نفس الكود لكل مكان :

Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, NewFile2, NewFile3, CopyMyDB

OldFile = CurrentDb.Name

DBwithEXT = Dir(OldFile)

DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)

NewFile = "c:\mybackup\" & "\" & DBwithoutEXT & Right(DBwithEXT, 4)

CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"

Shell CopyMyDB, 0

MyErr:

If Err.Number <> 0 Then

MsgBox Err.Number & " - " & Err.Description

End If

Call Shell("regedit.exe /s """ & CurrentProject.Path & "\Enable.reg""", 0)


OldFile = CurrentDb.Name

DBwithEXT = Dir(OldFile)

DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)

NewFile2 = "d:\mybackup\" & "\" & DBwithoutEXT & Right(DBwithEXT, 4)

CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile2 & """"

Shell CopyMyDB, 0

Call Shell("regedit.exe /s """ & CurrentProject.Path & "\Enable.reg""", 0)


OldFile = CurrentDb.Name

DBwithEXT = Dir(OldFile)

DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)

NewFile3 = "f:\mybackup\" & DBwithoutEXT & Right(DBwithEXT, 4)

CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile3 & """"

Shell CopyMyDB, 0

Call Shell("regedit.exe /s """ & CurrentProject.Path & "\Enable.reg""", 0)


MsgBox "تم نسخ قاعدة البيانات بنجاح ..", vbOKOnly, "تم النسخ بنجاح"

[ابوخليل]

لست مضطرا لتكرار الكود

فقط تعديل بسيط على الكود السابق

ملحوظة : من اجل التطبيق استبدلت القرص F بــ E

ايضا سيتم نسخ القاعدة مباشرة بدون مجلدات

Private Sub Backup_Click()

Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, NewFile2, NewFile3, CopyMyDB, CopyMyDB2, CopyMyDB3

OldFile = CurrentDb.Name

DBwithEXT = Dir(OldFile)

DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)

NewFile = "c:\" & "\" & DBwithoutEXT & Right(DBwithEXT, 4)

NewFile2 = "d:\" & "\" & DBwithoutEXT & Right(DBwithEXT, 4)

NewFile3 = "e:\" & "\" & DBwithoutEXT & Right(DBwithEXT, 4)

CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"

CopyMyDB2 = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile2 & """"

CopyMyDB3 = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile3 & """"

Shell CopyMyDB, 0

Shell CopyMyDB2, 0

Shell CopyMyDB3, 0

MyErr:

If Err.Number <> 0 Then

MsgBox Err.Number & " - " & Err.Description

End If

Call Shell("regedit.exe /s """ & CurrentProject.Path & "\Enable.reg""", 0)

MsgBox "تم نسخ قاعدة البيانات بنجاح ..", vbOKOnly, "تم النسخ بنجاح"

End Sub

dbdb.rar

[jafar089]

مشكور جزيلاً .