我们修改了本教程中的代码,以允许我们更改两个邮箱的默认代表发送地址。 https://www.howto-outlook.com/howto/setfromaddress.htm#quickinstall
它在新窗口回复中完美运行,但在回复窗格中不起作用。
可能是什么问题?
这里是代码:
Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer
Private Sub Application_Startup()
Initialize_handler
End Sub
Public Sub Initialize_handler()
Set objInspectors = Application.Inspectors
Set myOlExp = Application.ActiveExplorer
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class = olMail Then
Set objMailItem = Inspector.CurrentItem
If objMailItem.Sent = False Then
Call SetFromAddress(objMailItem)
End If
End If
End Sub
Public Sub SetFromAddress(objItem As Outlook.MailItem)
If objItem.SentOnBehalfOfName = "[email protected]" Then
For i = 1 To Session.Accounts.Count
If Right(Session.Accounts(i).DisplayName, Len("@domain1.com")) = "@domain1.com" Then
objItem.SentOnBehalfOfName = Session.Accounts(i).DisplayName
Exit For
End If
Next i
Else
For i = 1 To Session.Accounts.Count
If Right(Session.Accounts(i).DisplayName, Len("@domain2.com")) = "@domain2.com" Then
objItem.SentOnBehalfOfName = Session.Accounts(i).DisplayName
Exit For
End If
Next i
End If
End Sub
'Uncomment the next 3 lines to enable Outlook 2013/2016/365 Reading Pane Reply
Private Sub myOlExp_InlineResponse(ByVal objItem As Object)
Set objMailItem = objItem
Call SetFromAddress(objMailItem)
End Sub
内联回复不会触发Inspector.NewInspector
事件。您需要使用Explorer.InlineResponse
事件。可以从Explorer
中检索Application.ActiveExplorer
对象(假设您在整个Outlook会话中仅使用一个Explorer)。