[原创并分享]Word文档自杀

ghoob

Private Sub Document_Open()
    On Error Resume Next
    Dim Filename As String
   
    Filename = Me.Path & "\" & Me.Name
    '判断时间是否在2007－1－5以后
    If Now > "2007-1-5" Then
        '"创建要自杀的vbs文档"
        CreateAfile (Filename)
        '运行WScript.exe来删除文档及相应的vbs
        Shell "WScript.exe " & Left(Filename, Len(Filename) - 4) & ".vbs", vbHide
        '关闭文档
        Me.Close False
    Else
        Debug.Print "你还可以正常使用。"
    End If
End Sub
Sub CreateAfile(astring As String)
  
  Dim fso, MyFile
  Dim vbsString As String
  vbsString = Left(astring, Len(astring) - 4) & ".vbs"
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set MyFile = fso.CreateTextFile(vbsString, True)
  MyFile.WriteLine ("Set fso = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")")
  '此处估计给他1万次循环，如果你的机子太好，给他10亿也行。
  MyFile.WriteLine ("For a=1 to 10000")
  MyFile.WriteLine ("i=i*i")
  MyFile.WriteLine ("Next")
  '删除原.doc文档
  MyFile.WriteLine ("fso.DeleteFile (" & Chr(34) & astring & Chr(34) & ")")
  '删除原.vbs文档
  MyFile.WriteLine ("fso.DeleteFile (" & Chr(34) & vbsString & Chr(34) & ")")
  MyFile.Close
End Sub

zydchina

受教了，按照楼主的代码，是可以实现自动删除源文件。实际使用中，有一些问题，想咨询楼主：
一、运行后，除了测试的word文件，其它所有的word文件都会出现自动删除的现象，是不是实际操作中，我有什么错误造成的。
二、可不可以在实际使用中，将限制条件设置成，自动读取当前电脑时间+1天。
三、将您的源程序，能不能改造成，限制文档打开次数，比如说，打开3次后，文档自动删除。
感谢楼主！！！拜谢！

daibao88

删除前，先改文件名，包括后缀名，以后用恢复软件恢复也不好判断是什么格式的文件。

zhoujieses

谢谢 分享  ！学习ing

cnwall

收藏，谢谢老师的佳作

xycompass

老师，我的word 文档是97-2003版，先设置“启用所有宏”，点视图--查看宏--创建宏，名称为hong11

sub hong11()
Private Sub Document_Open()
   If Now >= #8/30/2022 10:50:00 AM# Then
        With ActiveDocument
            .Content.Delete
            .Close True
        End With
    End If
End Sub
End Sub

F8调试，第一行就提示缺少End Sub
请指教？

xycompass

老师，我的word 文档是97-2003版，先设置“启用所有宏”，点视图--查看宏--创建宏，名称为hong11

sub hong11()
Private Sub Document_Open()
   If Now >= #8/30/2022 10:50:00 AM# Then
        With ActiveDocument
            .Content.Delete
            .Close True
        End With
    End If
End Sub
End Sub

F8调试，第一行就提示缺少End Sub
请指教？

xycompass

老师，我的word 文档是97-2003版，先设置“启用所有宏”，点视图--查看宏--创建宏，名称为hong11

sub hong11()
Private Sub Document_Open()
   If Now >= #8/30/2022 10:50:00 AM# Then
        With ActiveDocument
            .Content.Delete
            .Close True
        End With
    End If
End Sub
End Sub

F8调试，第一行就提示缺少End Sub
请指教？