【原】【源代码】Excel定时自毁，你值得拥有

烟火 syrjldd

Excel函数|VBA交流①群

请教：有没有VBA使用次数达到100次自杀的代码？

答案：有

分为几种方法，先说一下最简单的。

1

达到某个指定日期，工作簿自行销毁

Private Sub workbook_open()
    Rem ***************************
    Rem  功    能: 定时自毁
    Rem  欢迎关注公众号：VBA说
    Rem ***************************
    On Error Resume Next
    Application.DisplayAlerts = False
    If Now() >= CDate("12/26/2020 10:22:00") Then
        ActiveWorkbook.ChangeFileAccess xlReadOnly
        Kill ActiveWorkbook.FullName
        Application.Quit
    End If
    Application.DisplayAlerts = Ture
End Sub


把这段代码放到工作簿事件里，就可以了。

最后文件到期的话，效果是这样的，打开就自动删除自己了。

这种方法对于VBA小白来说，足够了

2

达到一定次数，自行销毁

这种方法，直接将工作簿使用次数记录在注册表中，每次打开工作簿就读取注册表中的数据。获取已使用次数。

Private Sub Workbook_Open()
    Dim counter As Long, term As Long, chk
    chk = GetSetting("hhh", "budget", "使用次数", "")
    If chk = "" Then
        term = 50 '限制使用50次
        MsgBox "本工作簿只能使用" & term & "次" & vbCrLf & "超过次数将自动销毁!", vbExclamation
        SaveSetting "hhh", "budget", "使用次数", term '将值写入注册表
    Else
        counter = Val(chk) - 1 '计算剩余使用次数
        MsgBox "你还能使用" & counter & "次,请及时注册!", vbExclamation
        SaveSetting "hhh", "budget", "使用次数", counter '写入剩余次数
        If counter <= 0 Then '如果使用次数用完，就删除注册表记录使用次数的信息，调用自毁代码
            DeleteSetting "hhh", "budget", "使用次数"
            killme
        End If
    End If
End Sub

Public Sub killme()
    Application.DisplayAlerts = False
    ActiveWorkbook.ChangeFileAccess xlReadOnly
    Kill ActiveWorkbook.FullName
    ThisWorkbook.Close False
End Sub


我们可以看到，隐藏的很深，除非使用者手动删除注册表项。

我们假定，使用者比较聪明，换了台电脑试了试，发现可以使用了，那就让他多用几次吧。

其实可以获取电脑的cpu序列号、硬盘ID等等标识符来判别是不是换了新机子，这里不做深入研究。

▼

一顿操作猛如虎，有人想说，直接把核心代码砍掉就gg了（我想说，大哥，给个更文表现的机会好不好。）

其实我们做这一堆的前提是给不会VBA的小白设置的陷阱。

知识点　

Kill语句

用法：Kill   文件路径

需要注意的是，文件在使用状态下无法直接使用Kill。我们加了一句ChangeFileAccess xlReadOnly，这一条代表把文件设置成只读，设置成只读后，文件才不是使用状态，才能执行删除动作。

学而时习之不亦说乎，下面的历史文章可以再翻看一下。