I am using Chip Pearson's code for setting a timebomb. However I am getting a run-time error '1004' Application-defined or object-defined error when the ExpirationDate is set on the second line of execution. Shouldn't this run as is or am I missing something here? I don't get why the error isn't handled with the "On Error" code ...
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.
'
' Source: http://www.cpearson.com/excel/workbooktimebomb.aspx
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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))
ExpirationDate = CStr(DateSerial(Year(C_WORKBOOK_ISSUE_DATE), _
Month(C_WORKBOOK_ISSUE_DATE), Day(C_WORKBOOK_ISSUE_DATE) + 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) Or CDate(Now) < CDate(C_WORKBOOK_ISSUE_DATE) Then
If NameExists = False Then
ThisWorkbook.Save
End If
ThisWorkbook.ChangeFileAccess xlReadOnly
End If
ThisWorkbook.Names.Add.Delete
End Sub
Bookmarks