OutLookVBA开发时全部答复的按钮触发事件是什么？

海阔天空111

OutLookVBA开发时全部答复的按钮触发事件是什么？找了很多方法都触发不了？有没有大神帮解决下，谢谢了！！！

海阔天空111

在不添加按钮的情况下实现，也就是说在点击全部答复按钮时，我想加一些东西，新手刚接触outlook开发，大神们出来帮帮忙！！！

海阔天空111

没人回答我自己来
★ 第一步：
添加一个类模块并命名为 ReplyHandler，复制以下代码：

1. Option Explicit
   
2. 
   
3. Private WithEvents mItem As MailItem
   
4. Public WithEvents myExplorer As Explorer
   
5. 
   
6. ' #########
   
7. ' 析构函数.
   
8. ' #########
   
9. Private Sub Class_Terminate()
   
10.     If Not (mItem Is Nothing) Then
    
11.         Set mItem = Nothing
    
12.     End If
    
13.      
    
14.     If Not (myExplorer Is Nothing) Then
    
15.         Set myExplorer = Nothing
    
16.     End If
    
17. End Sub
    
18. 
    
19. ' #############################################################
    
20. ' 事件: 当用户为项目 (父对象的一个实例) 选择 "答复" 动作时发生.
    
21. ' #############################################################
    
22. Private Sub mItem_Reply(ByVal Response As Object, _
    
23.                         Cancel As Boolean)
    
24.      
    
25.     Response.Subject = "[修改邮件主题为指定的名称]"
    
26. End Sub
    
27. 
    
28. ' ##################################################
    
29. ' 事件: 选择其他或更多 Microsoft Outlook 项目时发生.
    
30. ' ##################################################
    
31. Private Sub myExplorer_SelectionChange()
    
32.     Dim mySel As Selection
    
33.      
    
34.     Set mySel = myExplorer.Selection
    
35.      
    
36.     ' /* 浏览器窗口中有且只有一个项目被选中. */
    
37.     If mySel.Count = 1 Then
    
38.         Dim objItem As Object
    
39.          
    
40.         Set objItem = mySel.Item(1)
    
41.          
    
42.         ' /* 该选中项目是邮件. */
    
43.         If objItem.Class = olMail Then
    
44.             ' /* 动态注册邮件的 Reply 事件. */
    
45.             Set mItem = objItem
    
46.         End If
    
47.     End If
    
48.      
    
49.     Set mySel = Nothing
    
50.     Set objItem = Nothing
    
51. End Sub
    
52. 
    
53. ' #####################################
    
54. ' 强制触发浏览器窗口中的选中项改变事件.
    
55. ' #####################################
    
56. Public Sub ForceSelectionChange()
    
57.     Call myExplorer_SelectionChange
    
58. End Sub

复制代码

★ 第二步：
添加一个模块（名称只要合法就行），复制以下代码：
Option Explicit

Dim rHandler As ReplyHandler

' #############
' 挂钩邮件回复.
' #############
Public Sub HookReply()
    Set rHandler = New ReplyHandler
    Set rHandler.myExplorer = Application.ActiveExplorer
    rHandler.ForceSelectionChange
End Sub

' #############
' 解钩邮件回复.
' #############
Public Sub UnhookReply()
    Set rHandler = Nothing
End Sub
★ 第三步：
运行 HookReply 宏即可挂钩邮件回复，如需停止对点击 "回复" 事件的监控，那么请运行 UnhookReply 进行解钩。
最后，附上两张运行效果图：
C:\Users\Administrator\Desktop\d52a2834349b033b7472ebb711ce36d3d439bde0.gif