Excel到期自動(dòng)銷毀，專治同事的拖延癥！

跟大家分享下如何在Excel中實(shí)現(xiàn)：數(shù)據(jù)到期，自動(dòng)銷毀的效果，跟大家分享解決的方法，可以根據(jù)自己的實(shí)際來(lái)設(shè)置。

一、Vba代碼

這個(gè)方法比較適合Excel用戶，默認(rèn)支持VBA代碼，打開文件會(huì)彈出文件還有多久到期，當(dāng)文件到期時(shí)會(huì)給出彈出，整個(gè)Excel工作簿會(huì)被刪掉。首先需要復(fù)制下面的代碼

Private Sub Workbook_Open()
' 設(shè)置開始日期和有效期天數(shù)
Dim startDate As Date
Dim validDays As Integer
' 在這里設(shè)置開始日期和有效期（天數(shù)）
startDate = #5/12/2025# ' 格式為#月/日/年#
validDays = 30 ' 文件有效天數(shù)
' 計(jì)算到期日期
Dim expiryDate As Date
expiryDate = DateAdd("d", validDays, startDate)
' 獲取當(dāng)前日期
Dim currentDate As Date
currentDate = Date
' 計(jì)算剩余天數(shù)
Dim daysRemaining As Integer
daysRemaining = DateDiff("d", currentDate, expiryDate)
' 檢查是否已過(guò)期
If daysRemaining <= 0 Then
' 文件已過(guò)期，顯示提示并安排刪除文件
MsgBox "此文件已過(guò)期，系統(tǒng)將自動(dòng)刪除該文件。", vbCritical, "文件已過(guò)期"
' 獲取當(dāng)前文件的完整路徑
Dim filePath As String
filePath = ThisWorkbook.FullName
' 創(chuàng)建臨時(shí)VBScript來(lái)刪除文件
CreateDeleteScript filePath
' 關(guān)閉當(dāng)前工作簿
ThisWorkbook.Saved = True ' 防止保存提示
Application.DisplayAlerts = False ' 禁用警告
ThisWorkbook.Close False
' 退出Excel
Application.Quit
Else
' 文件未過(guò)期，顯示剩余天數(shù)
MsgBox "此文件將在 " & daysRemaining & " 天后過(guò)期。" & vbCrLf & _
"到期日期: " & Format(expiryDate, "yyyy年mm月dd日"), _
vbInformation, "文件有效期提醒"
End If
End Sub
' 創(chuàng)建用于刪除文件的VBScript
Private Sub CreateDeleteScript(filePath As String)
Dim scriptContent As String
Dim scriptPath As String
Dim fso As Object
Dim scriptFile As Object
' VBScript內(nèi)容 - 等待Excel關(guān)閉后刪除文件
scriptContent = "On Error Resume Next" & vbCrLf & _
"Dim fso, wsh" & vbCrLf & _
"Set fso = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf & _
"Set wsh = CreateObject(""WScript.Shell"")" & vbCrLf & _
"' 等待5秒確保Excel已關(guān)閉" & 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"
' 獲取臨時(shí)文件夾路徑
Set fso = CreateObject("Scripting.FileSystemObject")
scriptPath = fso.GetSpecialFolder(2) & "\DeleteExcelFile.vbs"
' 創(chuàng)建VBScript文件
Set scriptFile = fso.CreateTextFile(scriptPath, True)
scriptFile.Write scriptContent
scriptFile.Close
' 執(zhí)行VBScript
Shell "wscript.exe """ & scriptPath & """", vbHide
' 清理對(duì)象
Set scriptFile = Nothing
Set fso = Nothing
End Sub

二、使用代碼

我們修改代碼的2個(gè)地方，讓這個(gè)復(fù)制實(shí)際的需求，代碼修改后按下快捷鍵ALT+F11調(diào)出VBA的編輯窗口，之后找到【ThisWorkbook】將代碼粘貼到里面。按下快捷鍵【Ctrl+S】保存代碼，最后需要將文件另存為【XLSM】格式。這個(gè)格式可以保存宏代碼

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

validDays = 30 ' 文件有效天數(shù)

以上就是今天分享的全部?jī)?nèi)容，大家可以試一下，還是非常好用的~

如果你想要提高工作效率，不想再求同事幫你解決各種Excel問(wèn)題，可以了解下我的專欄，WPS用戶也能使用，講解了函數(shù)、圖表、透視表、數(shù)據(jù)看板等常用功能，AI的也已經(jīng)在路上了，后期都會(huì)免費(fèi)更新的