Good Day,
I do hope I'm in the Right Forum, if not My Apologies, and can I get directed to the Correct One?
My Apologies if what I am saying or asking sounds a bit funny or stupid, but I'm not a Programmer and just trying to get this code to work.
I found the Below Code on the Internet to try and put a Time Bomb in an Excel Spreadsheet, it was written in 2007 so is very Old.
It has a Option to Set a Number of Days, like 30 or 60 or 90:
*Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 30*
It then uses this plus today's Date to Calculate a Future Expiry Date which is Hidden on the Spreadsheet:
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
Then, each time the Spreadsheet is Opened, it Checks the Current Date against the Expiry Date and if it's the Same or Bigger, it Triggers a Status Change in the Status of the Excel Spreadsheet.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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
First Issue I have is that no matter what Number of Days I put in, it just Calculates 30 Days for the Expiry Date.
The Second is that even Thou the Expiry Date is in the Future, after it has been Calculated and Stored, It Immediately see The Future Expiry Date as Active and kicks off the Status Change.
I think because of the changes in Excel 365, the way the Expiry Date is Stored and Read has Changed and that is why the Code Kicks off Wrong, the Formatting is to Old?
I have also attached a Picture of the Code as I don't know if this will come out readable. Any Help will be Greatly Appreciated, if any more information or if an Example Excel File with the Code is Needed, Please let me know and I will provide it.
Regards Kennedy