Force a Password Change every XX days

[ChrisRidgway]

I've been using MrExcel for years but always found what I needed and never had a need to post before.

I was hoping someone could help me with a strange request:

Does anyone know of a method of have the code that I could use to force a user to change the workbook Password every 90 days? and possibly have a "your password will expire in X Days" message box simular to how active directory forces the change?

Any replies or direction will be greatly appreciated.

 

[HackSlash]

First you're going to need a way of storing the last change date value. Putting it in a worksheet cell is the easiest answer. Anything else will take a bunch more code, time, thinking. Hide the "Settings" sheet if you don't want the user to see it.

Then you need to capture the user with something like "Workbook_BeforeSave"

I prefer "on save" over "on open" because you don't want to bother the user until it's time to set the password, which is at the save event.

NOTE: This code must go inside "ThisWorkbook" object in the Project tree. It won't run from anywhere else.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ExpireDays As Long
    Dim WarnDays As Long
    Dim DaysSinceLast As Long
    Dim LastChange As Date
    
    ExpireDays = 90
    WarnDays = 7
    LastChange = ThisWorkbook.Sheets("Settings").Range("A2").Value
    DaysSinceLast = DateDiff("d", Date, LastChange)
    
    If DaysSinceLast > ExpireDays Then
        'Force user to change password code
        ThisWorkbook.Sheets("Settings").Range("A2").Value = Date
    ElseIf DaysSinceLast > (ExpireDays - WarnDays) Then
        Dim x As Long
        x = ExpireDays - DaysSinceLast
        MsgBox "your password will expire in " & x & " Days"
    Else
        'Normal Save occurs here
    End If
End Sub