网站首页 > 知识剖析 正文
跟大家分享下如何在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的也已经在路上了,后期都会免费更新的
猜你喜欢
- 2025-06-23 MySQL 8.0 参考手册— 内置函数和运算符参考
- 2025-06-23 SqlServer根据身份证号码查询出生日期和年龄
- 2025-06-23 VBA数组处理数据的财会实战案例(vba数组计算函数)
- 2025-06-23 mysql——日期操作(mysql日期+1)
- 2025-06-23 odps sql中常用的时间处理方法(pmod sql)
- 2025-06-23 MySQL常用函数(MySQL常用函数案例)
- 2025-06-23 大数据量惯用优化方法(大数据量解决方案)
- 2025-06-23 一文掌握 DuckDB 时间序列分析:窗口函数实战详解
- 2025-06-23 MySQL 时间计算组合:助力精准工龄及补偿金计算
- 2025-06-23 SELECT list is not in GROUP BY clause_mysql执行的时候报错了
- 最近发表
- 标签列表
-
- xml (46)
- css animation (57)
- array_slice (60)
- htmlspecialchars (54)
- position: absolute (54)
- datediff函数 (47)
- array_pop (49)
- jsmap (52)
- toggleclass (43)
- console.time (63)
- .sql (41)
- ahref (40)
- js json.parse (59)
- html复选框 (60)
- css 透明 (44)
- css 颜色 (47)
- php replace (41)
- css nth-child (48)
- min-height (40)
- xml schema (44)
- css 最后一个元素 (46)
- location.origin (44)
- table border (49)
- html tr (40)
- video controls (49)