CODEWITHSUNDEEP
vbaoutlook-2010
BlueBeardo
BlueBeardo

Reputation: 47

Outlook VBA change Send using account when item load

I'm trying to change the From account when an item loads in Outlook 2010 using VBA. I have two accounts, a gmail account and a POP3.

When replying, replying all, and forwarding Outlook defaults to the account that the email was received through. If I receive an email through Gmail, I want to reply with a POP3 account. Even though my default account is the POP3 account, Outlook changes it to Gmail.

This is what I have so far. Unfortunately I get the error: Run-time error '-6936698555 (d6a70005)': You don't have appropriate permission to perform this operation.

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

Am I going about this the right way by doing it on Item load? Why don't I have permission to change the sender? Is it because VB didn't create the email?

Upvotes: 1

Views: 10769

Answers (2)

codeonabike
codeonabike

Reputation: 11

I'm late to this party, but I was trying to do something very similar and ran across your question/code. I managed to get it working.

The problem is that GetCurrentItem() is returning the mail item from your inbox (or wherever). What you need to modify is the new message created by hitting "reply".

I took your code and modified it. I've added a reply event that changes the SendUsingAccount property of the response. The ItemLoad event checks the 'To' property of the current mail item to decide whether or not to set the reply event.

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

Upvotes: 1

Graham Anderson
Graham Anderson

Reputation: 1239

I think the mailitem should be set using the following:

Set oMail = OutApp.CreateItem(olMailItem)

and setting the application should be done either using:

Set OutApp = CreateObject("Outlook.Application")

if outlook isn't open or the following if it is:

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

I haven't used SendUsingAccount, I'm guessing you would need to set the account to your alternative account. I have used SendOnBehalfOfName maybe this would work e.g.

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

Upvotes: 0

Related Questions