Forum Discussion

MCI-IT's avatar
MCI-IT
Copper Contributor
Aug 30, 2021

VBA Timebomb in Excel Spreadsheet

MS Excel 365 MSO (16.0.14326.20164) 64-bit

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

 

 

  • MCI-IT 

    The code sets up the ExpirationDate name the first time it is run.

    If you change the value of C_NUM_DAYS_UNTIL_EXPIRATION after that, it won't affect the value of ExpirationDate. You'd have to remove the defined name and run the code again.

     

    It'd be helpful if you could attach a sample workbook with the complete code.

    • MCI-IT's avatar
      MCI-IT
      Copper Contributor

      HansVogelaar  Thank You very Much Hans for the Reply, I really Appreciate it. Understood on the First Issue, it makes sense else the Date will keep on changing. Please find Attached a Sample Workbook with the Code. Please let me know if you require anything else.

      There are two Modules, modTimeBomb with the Code in and unHideDate to show the Hidden Named Range Created.

       

      Regards

      Kennedy

Resources