时间炸弹在几天后应用更改

Question

我在网上找到了一个在Excel电子表格中放置定时炸弹的代码。

有设置天数的选项，比如30天、60天或90天:

Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 30

然后使用该值加上今天的日期来计算隐藏在电子表格中的未来到期日期。
然后，每次打开电子表格时，它都会根据到期日期检查当前日期，如果到期日期相同或更大，它会触发Excel电子表格中的状态更改。

Sub TimeBombMakeReadOnly()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TimeBombMakeReadOnly
' This procedure uses a defined name to store the expiration
' date and if the workbook has expired, makes the workbook
' read-only.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ExpirationDate As String
Dim NameExists As Boolean
On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
NameExists = False
Else
NameExists = True
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, make the
' workbook read only. We need to Save the workbook
' to keep the newly created name intact.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If CDate(Now) >= CDate(ExpirationDate) Then
If NameExists = False Then
ThisWorkbook.Save
End If
ThisWorkbook.ChangeFileAccess xlReadOnly
End If
End Sub

第一个问题是，无论我输入多少天，它都计算30天的到期日期。

第二个是即使过期日期是在未来，在计算和存储之后，它立即将未来日期视为活动并启动状态更改。

我认为由于Excel 365中的变化，过期日期的存储和读取方式发生了变化，格式太旧了?

Answer 1

尝试分隔日期和文本:

Dim ExpirationDate As Date
Dim ExpirationText As String
Dim NameExists As Boolean
On Error Resume Next
ExpirationDate = DateValue(ThisWorkbook.Names("ExpirationText").Value)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
ExpirationDate = DateAdd("d", C_NUM_DAYS_UNTIL_EXPIRATION, Date)
ExpirationText = Format(ExpirationDate, "yyyy-mm-dd")
ThisWorkbook.Names.Add Name:="ExpirationText", _
RefersTo:=ExpirationText, _
Visible:=False
NameExists = False
Else
NameExists = True
End If

然后:

If Date >= ExpirationDate Then
If NameExists = False Then
ThisWorkbook.Save
End If
ThisWorkbook.ChangeFileAccess xlReadOnly
End If