How to Write a Workbook Self-Deletion Code When a Specific Date is reached?

[Wulf]

You design, build, and complete a Workbook.

But you want this Workbook to self-delete itself when a certain date is reached.

IE: You sell it, it's good for one year, and the ones who bought have the option to renew it at the end of that year. They choose NOT to, so when that time comes around, you need it to self-delete itself.

How do I write that VBA code?

Thank you.

 

[KOKOSEK]

Put somewhere is your code

if date1>=date2 then Call SuicideSub

Sub SuicideSub()
' Original code from Tom Urtis
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
Application.Quit
End With
End Sub

 

[Wulf]

Put somewhere is your code

if date1>=date2 then Call SuicideSub

Sub SuicideSub()
' Original code from Tom Urtis
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
Application.Quit
End With
End Sub

The line "if date1>=date2"... I have to assume that these are reference dates for the code to trigger.
How/where do I edit these?

Thank you.

 

[Logit]

After and on July 1 this year, the code would not run past the first line because the current date would be greater than the criteria date.

Code:

Sub t()
If Date >= #7/1/2019# Then Exit Sub 'change this from Exit Sub to Kill and the filename
'Your regular code here
End Sub

Date is current date
The date with the pound symbols is the criteria date. The pound symbols make it date literal so it will be the correct data type.

You auto run the above macro with a reference in the ThisWorkbook_Open module :

Private Sub ThisWorkbook_Open()
     Call t
End Sub

 

[Wulf]

I can't get it to work.

I eventually ended up with this:
Private Sub ThisWorkbook_Open()
If Date >= #8/7/2020# Then Call SuicideSub
Sub SuicideSub()
' Original code from Tom Urtis
With ThisWorkbook
.Saved = True
Kill .FullName
Application.Quit
End With
End Sub

Which does nothing, but when I had your code as typed, it kept telling me that there was an error and would send me to the Debugger.

The code below does nothing, either.
If Date >= #8/7/2020# Then Call SuicideSub
Sub SuicideSub()
' Original code from Tom Urtis
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
Application.Quit

I can't get anything to execute the desired effect.

 

[Logit]

.
In the THISWORKBOOK MODULE .. paste this :

Option Explicit

Private Sub Workbook_Open()
        SuicideSub
End Sub

Then in a REGULAR MODULE .. paste this :

Option Explicit

Sub SuicideSub()
    If Date >= #8/6/2020# Then
        ActiveWorkbook.Saved = True
        Application.ActiveWorkbook.ChangeFileAccess xlReadOnly
        Kill Application.ActiveWorkbook.FullName
    End If
    Application.Quit
End Sub

Then save the workbook. Next time you open the workbook it will self-destruct. No reversal / no second chances to re-consider.

 

[Wulf]

 

[Logit]

The above image shows where the macro Workbook_Open should be located. Look on the left and you will find THIS WORKBOOK. Double click on that, then in the large
white window that shows on the right ... paste the macro as shown above.

Next, from the menu bar up above, click on INSERT. Click on MODULE. In the large white window on the right, paste the following macro :