انتهاء صلاحية ملف

[seao]

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

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

Date.xlsm

[lionheart]

Private Sub Workbook_Open()
    If Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("D:").SerialNumber) <> "F8BCE74D" Then
        MsgBox "Message 1"
        ThisWorkbook.Close True
    End If
    If Date >= DateValue("12/12/2021") Or Sheets("Sheet2").Range("A48") = "mosaad" Then
        MsgBox "Expired", vbExclamation
        If InputBox("Enter Password") <> "123" Then
            Sheets("Sheet2").Range("A48") = "AA"
            MsgBox "  Message 2  "
            ThisWorkbook.Save
            Application.Quit
        End If
    End If
End Sub