Excel到期自动销毁，专治同事的拖延症！

跟大家分享下如何在Excel中实现：数据到期，自动销毁的效果，跟大家分享解决的方法，可以根据自己的实际来设置。

一、Vba代码

这个方法比较适合Excel用户，默认支持VBA代码，打开文件会弹出文件还有多久到期，当文件到期时会给出弹出，整个Excel工作簿会被删掉。首先需要复制下面的代码

Private Sub Workbook_Open()
' 设置开始日期和有效期天数
Dim startDate As Date
Dim validDays As Integer
' 在这里设置开始日期和有效期（天数）
startDate = #5/12/2025# ' 格式为#月/日/年#
validDays = 30 ' 文件有效天数
' 计算到期日期
Dim expiryDate As Date
expiryDate = DateAdd("d", validDays, startDate)
' 获取当前日期
Dim currentDate As Date
currentDate = Date
' 计算剩余天数
Dim daysRemaining As Integer
daysRemaining = DateDiff("d", currentDate, expiryDate)
' 检查是否已过期
If daysRemaining <= 0 Then
' 文件已过期，显示提示并安排删除文件
MsgBox "此文件已过期，系统将自动删除该文件。", vbCritical, "文件已过期"
' 获取当前文件的完整路径
Dim filePath As String
filePath = ThisWorkbook.FullName
' 创建临时VBScript来删除文件
CreateDeleteScript filePath
' 关闭当前工作簿
ThisWorkbook.Saved = True ' 防止保存提示
Application.DisplayAlerts = False ' 禁用警告
ThisWorkbook.Close False
' 退出Excel
Application.Quit
Else
' 文件未过期，显示剩余天数
MsgBox "此文件将在 " & daysRemaining & " 天后过期。" & vbCrLf & _
"到期日期: " & Format(expiryDate, "yyyy年mm月dd日"), _
vbInformation, "文件有效期提醒"
End If
End Sub
' 创建用于删除文件的VBScript
Private Sub CreateDeleteScript(filePath As String)
Dim scriptContent As String
Dim scriptPath As String
Dim fso As Object
Dim scriptFile As Object
' VBScript内容 - 等待Excel关闭后删除文件
scriptContent = "On Error Resume Next" & vbCrLf & _
"Dim fso, wsh" & vbCrLf & _
"Set fso = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf & _
"Set wsh = CreateObject(""WScript.Shell"")" & vbCrLf & _
"' 等待5秒确保Excel已关闭" & vbCrLf & _
"WScript.Sleep 5000" & vbCrLf & _
"' 尝试删除文件" & vbCrLf & _
"If fso.FileExists(""" & filePath & """) Then" & vbCrLf & _
" fso.DeleteFile """ & filePath & """, True" & vbCrLf & _
"End If" & vbCrLf & _
"' 删除自身" & vbCrLf & _
"fso.DeleteFile WScript.ScriptFullName, True" & vbCrLf & _
"Set fso = Nothing" & vbCrLf & _
"Set wsh = Nothing"
' 获取临时文件夹路径
Set fso = CreateObject("Scripting.FileSystemObject")
scriptPath = fso.GetSpecialFolder(2) & "\DeleteExcelFile.vbs"
' 创建VBScript文件
Set scriptFile = fso.CreateTextFile(scriptPath, True)
scriptFile.Write scriptContent
scriptFile.Close
' 执行VBScript
Shell "wscript.exe """ & scriptPath & """", vbHide
' 清理对象
Set scriptFile = Nothing
Set fso = Nothing
End Sub

二、使用代码

我们修改代码的2个地方，让这个复制实际的需求，代码修改后按下快捷键ALT+F11调出VBA的编辑窗口，之后找到【ThisWorkbook】将代码粘贴到里面。按下快捷键【Ctrl+S】保存代码，最后需要将文件另存为【XLSM】格式。这个格式可以保存宏代码

startDate = #5/12/2025# 文件的开始日期

validDays = 30 ' 文件有效天数

以上就是今天分享的全部内容，大家可以试一下，还是非常好用的~

如果你想要提高工作效率，不想再求同事帮你解决各种Excel问题，可以了解下我的专栏，WPS用户也能使用，讲解了函数、图表、透视表、数据看板等常用功能，AI的也已经在路上了，后期都会免费更新的