Outlook VBA change Отправить с учетной записью при загрузке элемента

Question

Я пытаюсь изменить учетную запись From, когда товар загружается в Outlook 2010 с использованием VBA. У меня две учетные записи, учетная запись gmail и POP3.

При ответе, ответе на все и пересылке Outlook по умолчанию для учетной записи, с которой было получено электронное письмо. Если я получаю письмо через Gmail, я хочу ответить с учетной записью POP3. Хотя моя учетная запись по умолчанию - это учетная запись POP3, Outlook изменяет ее на Gmail.

Это то, что у меня есть до сих пор. К сожалению, я получаю сообщение об ошибке: Ошибка времени выполнения '-6936698555 (d6a70005)': У вас нет соответствующего разрешения для выполнения этой операции.

Private Sub Application_ItemLoad(ByVal Item As Object) 
    Set myObj = GetCurrentItem() 
    If TypeName(myObj) = "MailItem" Then 
     Set OutApp = CreateObject("Outlook.Application") 
     Set oMail = OutApp.CreateItem(olMailItem) 
     Dim oAccount As Outlook.Account 

     Set oMail = myObj 

     oMail.SendUsingAccount = oMail.SendUsingAccount.Session.Accounts.Item(1) 
    End If 
End Sub 


Function GetCurrentItem() As Object 
    Dim objApp As Outlook.Application 

    Set objApp = Application 
    On Error Resume Next 
    Select Case TypeName(objApp.ActiveWindow) 
     Case "Explorer" 
      Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1) 
     Case "Inspector" 
      Set GetCurrentItem = objApp.ActiveInspector.CurrentItem 
    End Select 

    Set objApp = Nothing 
End Function 

Я собираюсь сделать это правильно, выполнив это при загрузке предмета? Почему у меня нет разрешения на изменение отправителя? Это потому, что VB не создал письмо?

Answer 1

Я думаю, что MailItem должен быть установлен с помощью следующих действий:

Set oMail = OutApp.CreateItem(olMailItem) 

и установив приложение должно быть сделано либо с помощью:

Set OutApp = CreateObject("Outlook.Application") 

если прогноз не открыт или если он следующий является:

Set OutApp = GetObject(, "Outlook.Application") 

Я не использовал SendUsingAccount, я предполагаю, что вы должны были бы установить accou nt к вашей альтернативной учетной записи. Я использовал SendOnBehalfOfName, возможно, это сработает, например.

oMail.SentOnBehalfOfName = "Your POP3 account name" 
oMail.Send 

Answer 2

Я опаздываю на эту вечеринку, но я пытался сделать что-то очень похожее и наткнулся на ваш вопрос/код. Мне удалось заставить его работать.

Проблема заключается в том, что GetCurrentItem() возвращает почтовый элемент из вашего почтового ящика (или где угодно). Что нужно изменить, так это новое сообщение, созданное нажатием «ответ».

Я принял ваш код и изменил его. Я добавил событие ответа, которое изменяет свойство SendUsingAccount ответа . Событие ItemLoad проверяет свойство «Кому» текущего почтового элемента, чтобы решить, следует ли устанавливать событие ответа.

Public WithEvents SecondAcctMsg As MailItem 

Private Sub Application_ItemLoad(ByVal Item As Object) 
    Set myObj = GetCurrentItem() 
    If TypeName(myObj) = "MailItem" Then 
     Select Case myObj.To 
      Case "<relevant email address>" 

       Set SecondAcctMsg = myObj 

     End Select 
    End If 
End Sub 


Function GetCurrentItem() As Object 
    Dim objApp As Outlook.Application 

    Set objApp = Application 
    On Error Resume Next 
    Select Case TypeName(objApp.ActiveWindow) 
     Case "Explorer" 

      Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1) 
     Case "Inspector" 

      Set GetCurrentItem = objApp.ActiveInspector.CurrentItem 
    End Select 

    Set objApp = Nothing 
End Function 

Private Sub SecondAcctMsg _Reply(ByVal Response As Object, Cancel As Boolean) 

    ' Change Accounts index to relevant account 
    Response.SendUsingAccount = Application.Session.Accounts(2) 

End Sub