VBA - Send An Email Using Account That I Want

fiberboysa

Board Regular
Joined
Apr 25, 2012
Messages
89
Office Version
2019
Platform
Windows
Hi Dear All,
I found following code to send email from Excel using a specific account. But the thing is I am using two different accounts in Outlook and want to send some emails using the account that I specify in a cell in the excel sheet. Can anyone please can make this 1 in Set .SendUsingAccount = OutApp.Session.Accounts.Item(1) brackets a variable linked to excel sheet instead of a constant so I can use it? I am using Excel 2016.

Code:
[COLOR=#3366CC]Sub Mail_small_Text_Change_Account()[/COLOR][COLOR=black]'Only working in Office 2007-2016
'Don't forget to set a reference to Outlook in the VBA editor[/COLOR]
    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 = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody

        [COLOR=black]'SendUsingAccount is new in Office 2007
        'Change Item(1)to the account number that you want to use[/COLOR]
        Set .SendUsingAccount = OutApp.Session.Accounts.Item(1)

        .Send   [COLOR=black]'or use .Display[/COLOR]
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing [COLOR=#3366CC]End Sub[/COLOR]
 
Last edited:

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

fiberboysa

Board Regular
Joined
Apr 25, 2012
Messages
89
Office Version
2019
Platform
Windows
Please help so that i can pick that (1) in Set .SendUsingAccount = OutApp.Session.Accounts.Item(1) from a cell in a row. I have tried the following code but its not working giving me Run-tim error '5' Invalid procedure call or argument error...

Code:
Sub MailToDestination()    Dim SendTo As String
    Dim ToMSg As String
    Dim ToSubject As String
    Dim CC As String
    Dim AID As Integer
    For Each c In Range(Range("B2"), Range("B" & Cells.Rows.Count).End(xlUp))
        SendTo = c
        If Not (IsError(c.Offset(0, 1))) Then
            If c.Offset(0, 0) <> "" Then SendTo = c.Offset(0, 0)
        End If
        If SendTo <> “” Then
            ToSubject = c.Offset(0, 2)
            ToMSg = c.Offset(0, 3)
            CC = c.Offset(0, 1)
            AID = c.Offset(0, 6)
            Send_Mail SendTo, ToSubject, ToMSg, CC
        End If
    Next
End Sub
Sub Send_Mail(SendTo As String, ToSubject, ToMSg As String, CC As String)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim StrSignature As String
    Dim sPath As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    With OutMail
        .To = SendTo
        .CC = CC
        .BCC = ""
        .Subject = ToSubject
        .Body = ToMSg & vbCrLf & vbCrLf & "Best Regards,"
        Set .SendUsingAccount = OutApp.Session.Accounts.Item(AID)
        .Display  ' or just put .Send to directly send the mail instead of display
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,677
Hi,
Try this code:
Rich (BB code):
Sub MailToDestination()
  Dim SendTo As String
  Dim c As Range
  With CreateObject("Outlook.Application")
    For Each c In Range("B2", Range("B" & Cells.Rows.Count).End(xlUp))
      SendTo = Trim(c.Value)
      If SendTo <> "" Then
        .To = SendTo
        .CC = c.Offset(0, 1).Value
        .Subject = c.Offset(0, 2).ValueV
        .Body = c.Offset(0, 3).Value
        Set .SendUsingAccount = .Session.Accounts.Item(c.Offset(0, 6).Value)
        .Send ' or use .Display
      End If
    Next
  End With
End Sub
 
Last edited:

fiberboysa

Board Regular
Joined
Apr 25, 2012
Messages
89
Office Version
2019
Platform
Windows
Nope It did not worked. It game me error "Run-time error 424. Object Required"
I tried the following code...

Code:
Sub MailToDestination()    Dim SendTo As String
    Dim ToMSg As String
    Dim ToSubject As String
    Dim CC As String
    Dim AID As Integer
    For Each c In Range(Range("B2"), Range("B" & Cells.Rows.Count).End(xlUp))
        SendTo = c
        If Not (IsError(c.Offset(0, 1))) Then
            If c.Offset(0, 0) <> "" Then SendTo = c.Offset(0, 0)
        End If
        If SendTo <> “” Then
            ToSubject = c.Offset(0, 2)
            ToMSg = c.Offset(0, 3)
            CC = c.Offset(0, 1)
            AID = c.Offset(0, 6)
            Send_Mail SendTo, ToSubject, ToMSg, CC
        End If
    Next
End Sub
Sub Send_Mail(SendTo As String, ToSubject, ToMSg As String, CC As String)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim StrSignature As String
    Dim sPath As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    With OutMail
        .To = SendTo
        .CC = CC
        .BCC = ""
        .Subject = ToSubject
        .Body = ToMSg & vbCrLf & vbCrLf & "Best Regards,"
        Set .SendUsingAccount = OutApp.Session.Accounts.Item(c.Offset(0, 6).Value)
        .Display  ' or just put .Send to directly send the mail instead of display
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,677
I see now - there is my typo in this line .Subject = c.Offset(0, 2).ValueV
Should be
.Subject = c.Offset(0, 2).Value
 

fiberboysa

Board Regular
Joined
Apr 25, 2012
Messages
89
Office Version
2019
Platform
Windows
What code line has been yellowed by a debugger?
Same line which I need to be fixed :) i.e.
Code:
Set .SendUsingAccount = OutApp.Session.Accounts.Item(c.Offset(0, 6).Value)
 

fiberboysa

Board Regular
Joined
Apr 25, 2012
Messages
89
Office Version
2019
Platform
Windows
I see now - there is my typo in this line .Subject = c.Offset(0, 2).ValueV
Should be
.Subject = c.Offset(0, 2).Value
Above line is OK because I Just changed the line Set .SendUsingAccount = OutApp.Session.Accounts.Item(AID) to Set .SendUsingAccount = OutApp.Session.Accounts.Item(c.Offset(0, 6).Value)
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,677
Above line is OK because I Just changed the line Set .SendUsingAccount = OutApp.Session.Accounts.Item(AID) to Set .SendUsingAccount = OutApp.Session.Accounts.Item(c.Offset(0, 6).Value)
There is no such a line in my code, variable OutApp is not used in it.
Please copy/paste all the suggested code to a new VBA module and run it.
 
Last edited:

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,677
My bad, should be With CreateObject("Outlook.Application").CreateItem(0)
Rich (BB code):
Sub MailToDestination()
  Dim SendTo As String
  Dim c As Range
  With CreateObject("Outlook.Application").CreateItem(0)
    For Each c In Range("B2", Range("B" & Cells.Rows.Count).End(xlUp))
      SendTo = Trim(c.Value)
      If SendTo <> "" Then
        .To = SendTo
        .CC = c.Offset(0, 1).Value
        .Subject = c.Offset(0, 2).Value
        .Body = c.Offset(0, 3).Value
        Set .SendUsingAccount = .Session.Accounts.Item(c.Offset(0, 6).Value)
        .Send ' or use .Display
      End If
    Next
  End With
End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,102,713
Messages
5,488,460
Members
407,638
Latest member
brandynl

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top