Мы изменили код из этого руководства, чтобы позволить нам изменить адрес отправки по умолчанию для двух почтовых ящиков. 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 = "info@domain1.com" 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