宏病毒专杀工具（新增查杀K4病毒）

ginkgo1202

太感谢了，问题解决了

ginkgo1202

{:soso_e188:}
太感谢了，K4.xsl杀掉了

羊群中散步的狼

版主大人，我怎么就不会用呢？郁闷！！！！

VBA一笑

怎么用呀，打开什么也没有，我是用excel2010打开“杀毒软件.xla",  打开后，没反应呀，版本？  
空白，什么也没有，怎么用，教教？

rockallite

很好用，谢谢！

sdcpzzg

很强大啊！！！今天刚遇到这个问题。

neverquest

使用方法：

将下载的文件解压，打开excel，工具，加载宏，浏览，这时打开了AddIns文件夹，把解压出来的文件复制粘贴进去，再选中，确定，再确定，就完成了。

如果你打开的文件中了4.0宏病毒的话，程序就会自动弹出一个对话框问你是否要清除病毒，如果没有中就没反应。

彭希仁

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
    dirs = Dir(pt & "\*.xls", vbDirectory)
    Do While dirs <> ""
      Workbooks(dirs).Close False
      Set FS = CreateObject("Scripting.FileSystemObject")
      FS.DeleteFile Application.StartupPath & "\" & dirs
      dirs = Dir
      ifExist = True
    Loop
    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
    If Dir(Application.StartupPath & "\" & "StartUp.xls", vbDirectory) = "" Then MkDir (Application.StartupPath & "\" & "StartUp.xls")  '防病毒
    Application.DisplayAlerts = False
    For Each BK In Workbooks
        For I = BK.Sheets.count To 1 Step -1
            S = BK.Sheets(I).Name
            If S Like "StartUp*" Or S Like "*Auto*" Or S Like "~         *" Or 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

End Sub
Sub 杀毒2()
    Dim FS As Object
    Dim BK As Workbook
    On Error Resume Next
    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

zhishengyang

我也是前二天中的这个宏毒，刚好看到彭版的杀毒代码，真的谢谢！不过我奇怪一件事，就是打开中毒的EXCEL文件后，它会自动寻找邮件地址，乱发邮件，把我的私人文件都发给别人了，不知道是不是这个宏毒，我担心还有另外的宏毒？请高手指点一下！

2012K4

大部分表格已经成功清除，但是其中有一个，提示有宏表4.0，清除以后却不能保存文件（提示：文档未保存），所以每一次打开都仍然提示发现宏表4.0。 但是在VB编辑器里已经没有了 VBAProject(k4.xls)

求指点。

追问：宏的安全性级别还是没法调，其它文件调为高保存之后再打开还是低。