Outlook: изменение отправителя для использования функции "Отправить от имени"

Я сошел с ума, пытаясь понять это! Это длинный пост, но, пожалуйста, подождите и позвольте мне составить для вас сценарий:

Две команды: MainTeam и HelpingTeam

MainTeam использует исключительно общий почтовый ящик и использует макрос для отправки всех писем "от имени MainTeam " вместо простой отправки в качестве общего почтового ящика.

Пользователи HelpingTeam не используют общий почтовый ящик, но теперь время от времени собираются помогать другой команде. Когда они это сделают, им нужно изменить отправителя, чтобы указать, что их электронное письмо от основной команды, но оно все равно должно быть "от имени".

Общий почтовый ящик был добавлен пользователям в HelpingTeam, и в новом окне почты адрес электронной почты для общего почтового ящика находится ниже их личного. Использование этого адреса "От" будет означать, что они пытаются отправить почтовый ящик SendAs, что нам не нужно.

Конечно, я мог бы легко показать им, как добавить еще один адрес "От" и настроить его для использования их основной учетной записи в "SendonBehalfOf", но они не хотят запутаться, потому что теперь они увидят две записи в своем "От" список: запись "SendAs" (фиксированная, не может быть удалена) и запись "SendonBehalfOf" (может быть удалена).

Я пытался создать макрос (из исследованных макросов), который бы фиксировал этот сценарий и изменял свойства электронной почты, чтобы электронное письмо было отправлено пользователем от имени общего почтового ящика. При отправке электронного письма из общего почтового ящика с помощью этого макроса все работает отлично. При отправке электронного письма из личного почтового ящика и изменении отправителя на учетную запись "SendAs" (единственная общая учетная запись в списке) свойства макроса кажутся правильными, но Outlook не обрабатывает изменение, и система отклоняет сообщение.

Я сделал так много исправлений, что потерял представление о том, что работает, а что нет. Ниже представлена ​​наиболее функциональная версия, описанная выше. В сообщ окно записи, чтобы помочь мне отслеживать то, что происходит за кулисами:

       Dim oAccount As Outlook.Account
Dim objItem As MailItem
Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer
Dim Sender As Outlook.AddressEntry

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(objMailItem As Outlook.MailItem)
    'To see which account user is trying to send from
    MsgBox "[SetFromAddress] SendUsingAccount: " & objMailItem.SendUsingAccount
    MsgBox "[SetFromAddress] SentOnBehalfOfName: " & objMailItem.SentOnBehalfOfName
    
    'Check which account is in focus as primary
    If objMailItem.SendUsingAccount = "MainTeam@company.com" Then
        MsgBox "sendfromaddress if triggered"
        'set sender to be the Shared Mailbox
        objMailItem.SentOnBehalfOfName = "MainTeam@company.com"
          
        'Find Primary O365 account and use that to send the email "on behalf of"
        For Each oAccount In Application.Session.Accounts
            If oAccount = "U.ser@company.com" Then
                objMailItem.SendUsingAccount = oAccount
            End If
        Next
    End If
    
    MsgBox "SetFromAddress Sending As: " & objMailItem.SendUsingAccount
    MsgBox "SetFromAddress OnBehalf: " & objMailItem.SentOnBehalfOfName
End Sub

'Below enables Outlook 2013/2016/365 Reading Pane Reply
Private Sub myOlExp_InlineResponse(ByVal objItem As Object)
    Call SetFromAddress(objItem)
End Sub

'Added the sub below in case the user manually switchs from personal to shared mailbox
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    MsgBox "[ItemSend] SendUsingAccount: " & Item.SendUsingAccount
    MsgBox "[ItemSend] SentOnBehalfOfName: " & Item.SentOnBehalfOfName
    
    'Check if Shared Account
    If Item.SentOnBehalfOfName = "MainTeam@company.com" Then
        MsgBox "If triggered"
        'set sender to be the Shared Mailbox
        Item.SentOnBehalfOfName = "MainTeam@company.com"
        
        'Find Primary O365 account and use that to send the email "on behalf of"
        For Each oAccount In Application.Session.Accounts
            If oAccount = "U.ser@company.com" Then
                Item.SendUsingAccount = oAccount
            End If
        Next
    End If
    
    MsgBox "[ItemSend] SendUsingAccount: " & Item.SendUsingAccount
    MsgBox "[ItemSend] SentOnBehalfOfName: " & Item.SentOnBehalfOfName
End Sub

30.11.2020

Вот как я сейчас работаю над проблемой, но, как я уже упоминал, это не удается, если это встроенный ответ:

       Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
    Dim oAccount As Outlook.Account
    Dim objItem As MailItem
 
    'To test later which account user is trying to send from
    Set SendingAccount = item.SendUsingAccount
        
    'Check if Shared Account
    If SendingAccount = "MainTeam@company.com" Then

        'Intecept email, stop it from sending, and create a new one "on behalf of"
        If TypeOf item Is MailItem Then
            Set objItem = item.Copy
            item.Delete
            Cancel = True
                       
            'set sender to be the Shared Mailbox
            objItem.SentOnBehalfOfName = "MainTeam@company.com"
            
            'Find Primary O365 account and use that to send the email "on behalf of"
            For Each oAccount In Application.Session.Accounts
                If oAccount = "U.ser@company.com" Then
                    objItem.SendUsingAccount = oAccount
                End If
            Next
        End If
        
        'send email
        objItem.Send
    End If
End Sub
Источник

2 ответа

Похоже, я нашел отличный обходной путь! Хотя это и не ответ , он, по крайней мере, заставляет этот код работать. Я в основном отправил команду для проверки имен SendKeys "%k"(ALT+k), который проверяет поле отправителя и получателя. В то время как CTRL+k проверяет имена в новом сообщении, он открывает окно вставки гиперссылки на ответ, поэтому я выбрал ALT+k.

Я добавил это в конце инструкции SetFromAddress и for, которая проверяет правильность отправляющей учетной записи. Я тестировал как внутри, так и снаружи оператора for, но внутри работает каждый раз.

      Public Sub SetFromAddress(objMailItem As Outlook.MailItem)
    'To see which account user is trying to send from
    
    'Check which account is in focus as primary
    If objMailItem.SendUsingAccount = "MainTeam@company.com" Then
        'set sender to be the Shared Mailbox
        objMailItem.SentOnBehalfOfName = "MainTeam@company.com"
          
        'Find Primary O365 account and use that to send the email "on behalf of"
        For Each oAccount In Application.Session.Accounts
            If oAccount = "U.ser@company.com" Then
                objMailItem.SendUsingAccount = oAccount
            End If
        Next
    End If
    SendKeys "%k
End Sub

а также

                  For Each oAccount In Application.Session.Accounts
                If oAccount = "U.ser@company.com" Then
                    objItem.SendUsingAccount = oAccount
                    sendkeys (%k)
                End If
            Next
        End If

Он не идеален, но пока будет работать, пока я не придумаю, как обрабатывать встроенные ответы.

Источник

Мне нужно обманом заставить Outlook принять SentOnBehalfOfName. Ваша установка может отличаться.

Dim oAccount As account

Const mailAddressShared = "MainTeam@company.com"

Private Sub setSentOnBehalfName()
    Dim currItem As MailItem
    Set currItem = ActiveInspector.currentItem
    Debug.Print currItem.subject
    currItem.SentOnBehalfOfName = mailAddressShared
    currItem.Save
End Sub

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Debug.Print "[ItemSend] SendUsingAccount: " & Item.SendUsingAccount
    Debug.Print "[ItemSend] SentOnBehalfOfName: " & Item.SentOnBehalfOfName
    
    Dim copiedItem As Object
    
    'Check if Shared Account
    If Item.SentOnBehalfOfName = mailAddressShared Then
    
        ' trick Outlook into accepting .SentOnBehalfOfName
        Set copiedItem = Item.Copy
        
        'assign shared mailbox
        copiedItem.SentOnBehalfOfName = mailAddressShared
        Debug.Print "copiedItem.SentOnBehalfOfName: " & copiedItem.SentOnBehalfOfName
    
    ElseIf Item.SentOnBehalfOfName = "" Then
    
        If MsgBox("Assign shared mailbox to SentOnBehalfOfName?", vbYesNo) = vbYes Then
        
            ' trick Outlook into accepting .SentOnBehalfOfName
            Set copiedItem = Item.Copy
            
            'assign shared mailbox
            copiedItem.SentOnBehalfOfName = mailAddressShared
            Debug.Print "copiedItem.SentOnBehalfOfName: " & copiedItem.SentOnBehalfOfName
            
        End If
        
    End If
    
    'Find default account to send the email
    If Not copiedItem Is Nothing Then
    
        Item.Delete
        Cancel = True   ' cancels original item
        
        For Each oAccount In Session.Accounts
            If oAccount = Session.GetDefaultFolder(olFolderInbox).Parent Then
                copiedItem.SendUsingAccount = oAccount
                Exit For
            End If
        Next
        
        Debug.Print "[ItemSend] copiedItem.SendUsingAccount: " & copiedItem.SendUsingAccount
        Debug.Print "[ItemSend] copiedItem.SentOnBehalfOfName: " & copiedItem.SentOnBehalfOfName
    
        copiedItem.Send ' does not re-trigger ItemSend
        
    Else
    
        Debug.Print "[ItemSend] Item.SendUsingAccount: " & Item.SendUsingAccount
        Debug.Print "[ItemSend] Item.SentOnBehalfOfName: " & Item.SentOnBehalfOfName
        
        For Each oAccount In Session.Accounts
            If oAccount = Session.GetDefaultFolder(olFolderInbox).Parent Then
                Item.SendUsingAccount = oAccount
                Exit For
            End If
        Next
    
        Debug.Print "[ItemSend] Item.SendUsingAccount: " & Item.SendUsingAccount
    End If
    
End Sub
Источник
Другие вопросы по тегам