Excel VBA
自杀程序
2017-04-12 16:26:24

所谓EXCEL自杀功能,就是直接删除。当离职或者其他时候不想让人看到或者使用你的文件时,自动销毁。

自杀可以分为限定时间自杀,权限自杀自打开次数自杀等等.

下面提供几个例子:

1.在一台电脑上使用,如果复制到另一台电脑上,提示使用2个月,2个月后自动启动自杀程序,代码如下:

Sub Auto_Open()

    Dim fs, d, s

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(ThisWorkbook.Path)))

    s = d.serialnumber '磁盘序列号

    If s = 要使用的电脑磁盘序列号 Then Exit Sub

    Dim FirstDate, de, days

    FirstDate = Date

    de = GetSetting("XXX", "YYY", "date", "") '从注册表取值

    If de = "" Then '如果取不到值

        SaveSetting "XXX", "YYY", "date", FirstDate '把日期保存到注册表

        MsgBox "本文件可使用60天,今天是第1次使用", , "提示"

    Else

        days = Date - CDate(de) '计算文件使用的天数

        If days > 60 Then '如果文件使用超过60天

            MsgBox "已超过使用期限,本文件将自杀", , "警告"

            ThisWorkbook.ChangeFileAccess xlReadOnly '改为只读属性

            Kill ThisWorkbook.FullName '自杀

            ThisWorkbook.Close False '关闭不保存

        End If

        MsgBox "本文件已使用" & days & "天,还有" & 60 - days & "天可使用", , "提示"

    End If

End Sub

2.指定时间自杀

Private Sub Workbook_Open()

    Sheet1.Activate

    If Now >= DateSerial("2017", "10", "6") Then

        ActiveWorkbook.ChangeFileAccess xlReadOnly

        Kill ActiveWorkbook.FullName

        ThisWorkbook.Close False

    End If

End Sub

提醒:代码有风险,使用需谨慎