我有一段代码，如果我在回复某位客户时点击了 Reply 而不是 ReplyAll，则会弹出一条消息。
当我在活动窗口中打开电子邮件，但在资源管理器窗格中没有打开时，我让它运行。
我怀疑我需要在启动时运行更多的代码来设置这两种可能性。GetCurrentItem
（来自 slipstick）允许使用其中一种来获取邮件项信息，但它不会从资源管理器窗格中触发。
Dim WithEvents insp As Outlook.Inspectors
Dim WithEvents mailItem As Outlook.mailItem
' This is called on Outlook startup
Private Sub Application_Startup()
Set insp = Application.Inspectors
End Sub
' This is called when a new Inspector is created.
Private Sub insp_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class = olMail Then
Set mailItem = Inspector.CurrentItem
End If
End Sub
' Called when you press Reply
Private Sub mailItem_Reply(ByVal Response As Object, Cancel As Boolean)
Dim msg As String
Dim result As Integer
Dim strReplyAddress As String
Dim strtest As String
Dim olReply As mailItem
' enter the email address of your most valued customer here
strReplyAddress = "[email protected]"
Set mailItem = GetCurrentItem() ' should allow code to run in explorer or inspector
' this checks the reply email address.
' If it is the most valued customer then
' we need to see if Reply All has been selected!
If mailItem.Sender.Address = strReplyAddress Then
' check how many recipients.
' If it is greater than one then it is not being sent to ALL!!
If mailItem.Recipients.Count > 1 Then
msg = "You are replying to Sender Only" & vbCr & vbCr & _
"Do you want to Reply to All?" _
& vbCr & vbCr & "Click Yes to SEND to ALL" & vbCr & vbCr & _
"Click No to reply to SENDER ONLY" & vbCr & vbCr & _
"Click Cancel to CANCEL THIS EMAIL"
result = MsgBox(msg, vbYesNoCancel, "Reply Check")
If result = vbYes Then
Cancel = True
Set olReply = mailItem.ReplyAll
' this displays the email for sending with all recipients added.
olReply.Display
End If
If result = vbCancel Then
Cancel = True ' this stops the email from being created.
End If
' by default if you click NO the code ends up here
' without modification and displays the email
End If
End If
End Sub
答案1
这就是如何触发选择改变事件。
Dim WithEvents insp As Inspectors
Dim WithEvents mailItem As mailItem
Dim WithEvents myOlExp As Explorer
' This is called on Outlook startup
Private Sub Application_Startup()
Set insp = Inspectors
Set myOlExp = ActiveExplorer
End Sub
Private Sub myOlExp_SelectionChange()
' https://docs.microsoft.com/en-us/office/vba/api/Outlook.Explorer.SelectionChange
' there can be an array out of bounds error when changing folders
' uncomment if an error occurs
'On Error Resume Next
Set mailItem = ActiveExplorer.Selection(1)
'Debug.Print mailItem.subject
' Remove error bypass as soon as the purpose is served
On Error GoTo 0
End Sub
' This is called when a new Inspector is created.
Private Sub insp_NewInspector(ByVal Inspector As Inspector)
If Inspector.currentItem.Class = olMail Then
Set mailItem = Inspector.currentItem
End If
End Sub
' Called when you press Reply
Private Sub mailItem_Reply(ByVal Response As Object, Cancel As Boolean)
Dim msg As String
Dim result As Integer
Dim strReplyAddress As String
Dim strtest As String
Dim olReply As mailItem
strReplyAddress = "[email protected]" ' enter the email address of your most valued customer here
' this checks the reply email address.
' If it is the most valued customer then we need to see if Reply All has been selected!
If mailItem.Sender.Address = strReplyAddress Then
' check how many recipients in Response
' if equal to one then not being sent to ALL!!
Debug.Print Response.Recipients.count
If Response.Recipients.count = 1 Then
msg = "You are replying to Sender Only" & vbCr & vbCr & "Do you want to Reply to All?" _
& vbCr & vbCr & "Click Yes to SEND to ALL" & vbCr & vbCr & _
"Click No to reply to SENDER ONLY" & vbCr & vbCr & _
"Click Cancel to CANCEL THIS EMAIL"
result = MsgBox(msg, vbYesNoCancel, "Reply Check")
If result = vbYes Then
Cancel = True
Set olReply = mailItem.replyall
olReply.Display 'this displays the email for sending with all recipients added.
ElseIf result = vbCancel Then
Cancel = True ' this stops the email from being created.
End If
End If ' by default if you click NO the code ends up here without modification and displays the email
End If
End Sub