要是清除件內容的話，先用錄制宏，獲得清除內容的代碼，再加入一個一個時間判斷語句：
if date>#2010-08-01# then "清除內容的代碼"
最后將修改的代碼 放在 thisworkbook下 ：
Private Sub Workbook_Activate()
代碼
End Sub
打開三次后自我刪除
Option Explicit
Sub readopentimes()
Dim opentimes As Integer
With Me
opentimes = .CustomDocumentProperties("opentimes").Value + 1
If opentimes > 3 Then
Call killthisworkbook
Else
.CustomDocumentProperties("opentimes").Value = opentimes
.Save
End If
End With
End Sub
Sub killthisworkbook()
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close
End With
End Sub
killthiswork 這個已測試不錯
Private Sub Workbook_Open()
If Now() >= #9/15/2006# Then
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
Application.Quit
End If
End Sub
Private Sub Workbook_Open() '工作簿打開就執行
Application.DisplayAlerts = False '關閉提示
Dim datee As Date定義datee '為日期
datee = #9/19/2006#為datee '賦值
If Date > datee Then '如果當前日期大于設定的日期
ThisWorkbook.Sheets("Sheet3").Delete '刪除表sheets3
ThisWorkbook.Save '保存工作簿
Application.Quit '推出工作簿
End If
End Sub
再給一個過期則刪除工作簿(回收站都找不到)
Private Sub Workbook_Open()
Application.DisplayAlerts = False
Dim datee As Date
datee = #9/19/2006#
If Date > datee Then
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
ThisWorkbook.Close False
End If
End Sub
再給一個過期則自動刪除宏代碼之文件
Private Sub Workbook_Open()
Application.DisplayAlerts = False
Dim datee As Date
datee = #9/19/2006#
If Date > datee Then
Dim strFilePath, strJunk As String
strFilePath = Excel.Workbooks.Item(1).FullName
Close #1
Open strFilePath For Binary As #1
strJunk = Space(LOF(1))
Put #1, , strJunk
ThisWorkbook.Saved = True
ThisWorkbook.Close
End If
End Sub
