Macro to Send Email from different account

**automafia** · 03-04-2015, 03:16 PM

Hello,

I have Office 2013, and I am trying to write a macro to send an email from a certain account, but my Email_Send_From doesnt seem to be working. The email sends to who I want it to, and says what I want it to, but it is using the wrong email to send from.

Any help? I have several emails setup on my outlook. I want it to send from my gmail account. I have it setup with imap.

Thank you for the help.

Sub Email_Tenant_1934()
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Email_Subject = "Hello " & ActiveSheet.Range("B3")
Email_Send_From = "XXXX@gmail.com"
Email_Send_To = ActiveSheet.Range("B5")
Email_Cc = ""
Email_Bcc = ""
Email_Body = "It works!"
On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.cc = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
.send

MsgBox "Mail Has Been Sent"

End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub

**jaslake** · 03-04-2015, 03:20 PM

Hi automafia

Welcome to the Forum!!!

Please wrap your Code in Code Tags...it's a Forum requirement.

Do a search on "excel vba send email on behalf of"

**automafia** · 03-04-2015, 03:22 PM

Sorry about that. I have been searching the internet all morning on this and I havent found anything that has helped so far.

It is still sending from my main work account instead of the email I want it to send from.

**jaslake** · 03-04-2015, 04:15 PM

Hi automafia

This Code works for me...

Option Explicit

Sub Email_Tenant_1934()
   Dim Email_Subject, Email_Send_From, Email_Send_To, _
       Email_Cc, Email_Bcc, Email_Body As String
   Dim Mail_Object, Mail_Single As Variant
   Email_Subject = "Hello " & ActiveSheet.Range("B3")
   Email_Send_From = "XXXX@gmail.com"
   Email_Send_To = ActiveSheet.Range("B5")
   Email_Cc = ""
   Email_Bcc = ""
   Email_Body = "It works!"
   On Error GoTo debugs
   Set Mail_Object = CreateObject("Outlook.Application")
   Set Mail_Single = Mail_Object.CreateItem(0)
   With Mail_Single
      .SentOnBehalfOfName = "foo@bar.com"  '<---This works for me
      .Subject = Email_Subject
      .To = Email_Send_To
      .cc = Email_Cc
      .BCC = Email_Bcc
      .Body = Email_Body
      .Display

      MsgBox "Mail Has Been Sent"

   End With
debugs:
   If Err.Description <> "" Then MsgBox Err.Description
End Sub

**automafia** · 03-04-2015, 04:17 PM

Okay let me try that real quick

**automafia** · 03-04-2015, 04:22 PM

I get the following email when I try to send that.

Your message did not reach some or all of the intended recipients.

Subject: Hello Megan Schuelka
Sent: 3/4/2015 1:21 PM

The following recipient(s) cannot be reached:

Wes Smith on 3/4/2015 1:21 PM
This message could not be sent. Try sending the message again later, or contact your network administrator. Error is [0x80070005-00000000-00000000].

**jaslake** · 03-04-2015, 04:28 PM

No clue...Google it.

**automafia** · 03-04-2015, 04:32 PM

Weird. I get that error if I just hit send. But if I manually click the From: and then select the account I want to use it works. It looks the exact same before and after I select it.

**automafia** · 03-04-2015, 04:54 PM

I have figured it out!

Here is the solution.

After adding my Gmail account to Outlook, I closed outlook at restarted it.

I then ran this Macro:

Sub Which_Account_Number()
'Don't forget to set a reference to Outlook in the VBA editor
    Dim OutApp As Outlook.Application
    Dim I As Long

    Set OutApp = CreateObject("Outlook.Application")

    For I = 1 To OutApp.Session.Accounts.Count
        MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
    Next I
End Sub

Using this Macro I found that Outlook saw my gmail as Account Number 2.

I used the following code to send the email:

Sub Mail_small_Text_Change_Account()
'Only working in Office 2007-2013
'Don't forget to set a reference to Outlook in the VBA editor
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    On Error Resume Next
    With OutMail
        .To = "xxxxxx.xxx@xxxx.com"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody

        'SendUsingAccount is new in Office 2007
        'Change Item(1)to the account number that you want to use
       .SendUsingAccount = OutApp.Session.Accounts.Item(2)

        .Display
        
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

**jaslake** · 03-04-2015, 04:59 PM

Great work...I misunderstood your requirements.

You taught me something new today...Thank You.

Macro to Send Email from different account

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Macro to Send Email from different account

Re: Macro to Send Email from different account

Re: Macro to Send Email from different account

Re: Macro to Send Email from different account

Re: Macro to Send Email from different account

Re: Macro to Send Email from different account

Re: Macro to Send Email from different account

Re: Macro to Send Email from different account

Re: Macro to Send Email from different account

Re: Macro to Send Email from different account

Thread Information

Users Browsing this Thread

Similar Threads

Send email from non-default outlook account via VBA

Excel Email Macro VBA - How to send an email once all required fields have been fille

macro to send email.subject,body,email address are in 3 cells

Send data from Excel in email from specific email account

Email Macro using IMAP account

Bookmarks

Bookmarks

Posting Permissions