|
|
本帖最后由 彭希仁 于 2012-8-2 16:18 编辑
杀毒软件.rar
(10.2 KB, 下载次数: 15034)
模块代码
Public wyunx
Sub auto_open() '加载宏 ↓
On Error Resume Next
Set wyunx = New wor
Set wyunx.SHTd = Application
End Sub
Sub 杀毒()
Dim FS As Object
Dim BK As Workbook
Dim SHT As Worksheet
Dim ifExist As Boolean
Dim S As String
On Error Resume Next
'判断是否存在StartUp,以ifExist标记
ifExist = False
If Dir(Application.StartupPath & "\" & "StartUp.xls") <> "" Then ifExist = True
If ifExist = False Then
For Each BK In Workbooks
If ifExist Then Exit For
For Each SHT In BK.Sheets
S = SHT.Name
If S Like "StartUp*" Then
ifExist = True
If MsgBox("发现StartUp！" & vbCrLf & "StartUp可能影响你的Excel！是否清除？", vbOKCancel) = vbCancel Then Exit Sub
Exit For
End If
If SHT.Type = xlExcel4MacroSheet Then '干掉宏表
ifExist = True
If MsgBox("发现宏表4.0！" & vbCrLf & "宏表4.0可能影响你的Excel！是否清除？", vbOKCancel) = vbCancel Then Exit Sub
Exit For
End If
Next SHT
Next BK
End If
'判断是否清除StartUp
If ifExist = False Then Exit Sub
'关闭StartUp.xls
Workbooks("StartUp.xls").Close False
'删除文件
Set FS = CreateObject("Scripting.FileSystemObject")
FS.DeleteFile Application.StartupPath & "\" & "StartUp.xls"
'删除宏模块StartUp
If Dir(Application.StartupPath & "\" & "StartUp.xls", vbDirectory) = "" Then MkDir (Application.StartupPath & "\" & "StartUp.xls") '防病毒
Application.DisplayAlerts = False
For Each BK In Workbooks
For I = BK.Names.Count To 1 Step -1
If BK.Names(I).Name Like "*Auto*" Then
BK.Names(I).Delete
End If
Next I
For I = BK.Sheets.Count To 1 Step -1
S = BK.Sheets(I).Name
If S Like "StartUp*" Then BK.Sheets(I).Delete
If S Like "~ *" Then BK.Sheets(I).Delete
If BK.Sheets(I).Type = xlExcel4MacroSheet Then '干掉宏表
BK.Sheets(I).Visible = 1
BK.Sheets(I).Delete
End If
Next I
BK.Save
Next BK
Call 杀毒2
' Application.VBE.ActiveVBProject.VBComponents.Remove Application.VBE.ActiveVBProject.VBComponents("StartUp") 'StartUp
' Application.DisplayAlerts = True
'恢复变量
' Application.OnSheetActivate = ""
' Application.OnKey "%{F11}"
' Application.OnKey "%{F8}"
' MsgBox "清除StartUp完毕,自动退出！"
' ThisWorkbook.Close
End Sub
Sub 杀毒2()
Dim FS As Object
Dim BK As Workbook
On Error Resume Next
If Dir(Application.StartupPath & "\" & "K4.xls") <> "" Then
Workbooks("K4.xls").Close False
Set FS = CreateObject("Scripting.FileSystemObject")
FS.DeleteFile Application.StartupPath & "\" & "K4.xls"
End If
Application.DisplayAlerts = False
Dim Chgset As Boolean
Debug.Print ThisWorkbook.VBProject.Protection
If Err.Number = 1004 Then
Err.Clear
Application.SendKeys "%TMS%T%V{ENTER}"
Chgset = True
DoEvents
End If
For Each BK In Workbooks
With BK.VBProject.VBComponents("ThisWorkbook").CodeModule
.DeleteLines 1, .CountOfLines
End With
BK.VBProject.VBComponents.Remove BK.VBProject.VBComponents("ToDOLE")
BK.Save
Next BK
If Chgset Then Application.SendKeys "%TMS%T%V{ENTER}"
Application.DisplayAlerts = True
'恢复变量
Application.OnSheetActivate = ""
Application.OnKey "%{F11}"
Application.OnKey "%{F8}"
MsgBox "清除StartUp完毕,自动退出！"
End Sub
类模块代码
Public WithEvents SHTd As Application
Private Sub SHTd_WorkbookOpen(ByVal Wb As Workbook)
Call 杀毒
End Sub
使用方法：
将下载的文件解压，打开excel->工具->加载宏->浏览->这时打开了AddIns文件夹，把解压出来的文件复制粘贴进去，再选中，确定，再确定，就完成了。
如果你打开的文件中了4.0宏病毒的话，程序就会自动弹出一个对话框问你是否要清除病毒，如果没有中就没反应。
|
评分
-
22
查看全部评分
-
|
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2012-6-8 10:23
楼主
