有没有办法判断电子邮件中的活动/焦点文本字段是否在 VBA 中的 Outlook 中更改？ 即用户从“到”点击到“主题”

问题描述

当用户将活动字段从新电子邮件的“收件人”字段更改为电子邮件的正文时，我正在尝试执行例行程序。目的是能够使用收件人姓名自动填充问候语。

我让它立即运行以获取全部基于资源管理器选择更改的回复或回复，但我无法找到或找出正确的条件语句让脚本等到“To”字段之后点击离开。

有什么想法可以在 VBA 中实现吗？如果是这样怎么办？如果没有其他建议？

提前致谢！

Option Explicit
Private WithEvents oExpl As Explorer
Private WithEvents oItem As MailItem
Private bdiscardEvents As Boolean
Dim oResponse As MailItem
Dim oToField As MailItem

Private Sub Application_Startup()
   Set oExpl = Application.ActiveExplorer
   bdiscardEvents = False
End Sub

Private Sub oExpl_SelectionChange()
   On Error Resume Next
   Set oItem = oExpl.Selection.Item(1)   
End Sub

' Reply
Private Sub oItem_Reply(ByVal Response As Object,Cancel As Boolean)
   Cancel = True
   bdiscardEvents = True
Set oResponse = oItem.Reply
 afterReply
End Sub


' ReplyAll
Private Sub oItem_ReplyAll(ByVal Response As Object,Cancel As Boolean)
   Cancel = True
   bdiscardEvents = True
Set oResponse = oItem.ReplyAll
 afterReply
End Sub

Private Sub afterReply()
    oResponse.display
Dim Recipients As Outlook.Recipients
Dim R As Outlook.Recipient
Dim i
Dim strTo As String,strCC As String
Dim NameString As String
Dim NameArray() As String

Set Recipients = oResponse.Recipients
' step backwards so the order of the names is
' the same as in the address fields
For i = Recipients.Count To 1 Step -1
Set R = Recipients.Item(i)
    If R.Type = 1 Then
        NameString = R.Name
        
        If InStr(NameString,",") Then
        NameArray = Split(NameString," ")
        NameString = " " & NameArray(1)
        Else
        NameArray = Split(NameString," ")
        NameString = " " & NameArray(1)
        End If
        
        strTo = NameString & "," & strTo
    End If
Next

'insert the names
    Dim olInspector As Outlook.Inspector
    Dim olDocument As Word.Document
    Dim olSelection As Word.Selection
 
    Set olInspector = Application.ActiveInspector()
    Set olDocument = olInspector.WordEditor
    Set olSelection = olDocument.Application.Selection

    olSelection.InsertBefore ""
    olSelection.InsertParagraphBefore
    olSelection.InsertBefore ""
    olSelection.InsertParagraphBefore
  
    If Len(strTo) - Len(Replace(strTo,"")) < 4 Then
    olSelection.InsertBefore "Hi" & strTo
    Else
    olSelection.InsertBefore "Hi All,"
    End If
 
 SendKeys "{DOWN}",True
 
End Sub

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）