إستفسار: لماذا بعد كل عملية نسخ احتياطي للملفات يتم إلغاء الحماية ( كلمة السر ) لملف الاكسيس

الأساتذة الكرام ...

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

لماذ بعد كل عملية نسخ إحتياطي backup file لملف محمي بكلمة سر يتم إلغاء كلمة السر للملف الجديد 

نأمل الإفادة وكيف يتم تفادي المشكلة وعند النسخ الإحتياطي يكون الملف الإحتياطي محمي بكلمة السر ...

ملحوظه : الكود من ضمن سلسلة ابداع الاستاذة / زهرة بارك الله فيها ....

Option Compare Database
Option Explicit


Public Function Backup()
On Error GoTo Error_Handler
Dim sFile As String, oDB As DAO.Database
Dim strCurrentName As String
Dim oTD As TableDef
Dim qDF As QueryDef
Dim obj As AccessObject

strCurrentName = Application.CurrentObjectName
sFile = CurrentProject.Path & "\" & Left(CurrentProject.name, Len(CurrentProject.name) - 6) & " " & Format(date, "dd-mm-yyyy") & ".accdb"
If Dir(sFile) <> "" Then Kill sFile
Set oDB = DBEngine.Workspaces(0).CreateDatabase(sFile, dbLangGeneral)

'ÇáÌÏÇæá
For Each oTD In CurrentDb.TableDefs
If Left(oTD.name, 4) <> "MSys" Then
DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acTable, oTD.name, oTD.name, False
End If
Next oTD

'ÇáÇÓÊÚáÇãÇÊ
For Each qDF In CurrentDb.QueryDefs
If Left(qDF.name, 1) <> "~" Then
DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acQuery, qDF.name, qDF.name, False
End If
Next qDF


'ÇáäãÇÐÌ
For Each obj In CurrentProject.AllForms
DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acForm, obj.name, obj.name, False
Next obj

'ÇáÊÞÇÑíÑ
For Each obj In CurrentProject.AllReports
DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acReport, obj.name, obj.name, False
Next obj


'ÇáãÇßÑæ
For Each obj In CurrentProject.AllMacros
DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acMacro, obj.name, obj.name, False
Next obj

'ÇáæÍÏÇÊ ÇáäãØíÉ
For Each obj In CurrentProject.AllModules
DoCmd.TransferDatabase acExport, "Microsoft Access", sFile, acModule, obj.name, obj.name, False
Next obj

MsgBox " ãÈÑæß ... Êã ÇäÔÇÁ äÓÎÉ ÅÍÊíÇØíÉ Ýí äÝÓ ãÌáÏ ÇáÞÇÚÏÉ ÈÊÇÑíÎ Çáíæã ", vbInformation, "BackUp"

Error_Handler_Exit:
On Error Resume Next
Set qDF = Nothing
Set oTD = Nothing
Set obj = Nothing
oDB.Close
Exit Function

Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & "Error Number: " & Err.Number, vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit

End Function

Function RunSub()
Call Backup
End Function

مشكورين مقدماً