Help macro to delete itself after opeing the first time 90 days

alonelove

New Member
Joined
Sep 28, 2017
Messages
45
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
Hi all, I want macro to do this:

When opening excel file will check sheets("time").range("A1").
if cells is blank will set value of today => value the day opening file.
if cells have value of day will check: today subtract the day exist greater than 90 days will delete this excel file

For examble:
01/15/2020: The first time opening this file => Range(A1) blank will have value "01/15/2020"
04/14/2020: opening file => Do nothing because under 90 days from the first time opening file
04/16/2020: Opeing file => Delete itselt because over 90 days from the first time opening file

Please help me to do that by macro VBA, thanks./.
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

mole999

Moderator
Joined
Oct 23, 2004
Messages
10,524
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
you might consider forcing the file to save as xlsx after the 90 days open, which will remove the VBA, otherwise you are going to generate errors which you will have to deal with.
Providing the user starts with VBA enabled each time, you might opt for doing the save immediately
 

alonelove

New Member
Joined
Sep 28, 2017
Messages
45
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
Thanks @mole999 .

I found this code will delete file in special day but code i want the day is depend on the first time opening file.

Code i found is:
VBA Code:
Private Sub Workbook_Open()
 On Error Resume Next
 Dim Edate As Date
 Dim sh As Worksheet
Edate = Format("30/11/2016", "DD/MM/YYYY") '<----- set the delete date here
 If Date > Edate Then
 DeleteActiveWorkbook
End If
End Sub

Sub DeleteActiveWorkbook()
Dim xFullName As String
xFullName = Application.ActiveWorkbook.FullName
ActiveWorkbook.Saved = True
Application.ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill xFullName
Application.ActiveWorkbook.Close False
End Sub
 

mole999

Moderator
Joined
Oct 23, 2004
Messages
10,524
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
Edate = sheets("sheetname").range("A1") + 90
 

Watch MrExcel Video

Forum statistics

Threads
1,130,169
Messages
5,640,550
Members
417,151
Latest member
ChickenTenderer

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top