# VBA - Send An Email Using Account That I Want



## fiberboysa (Jan 22, 2019)

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.


```
[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]
```


----------



## fiberboysa (Feb 11, 2019)

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...


```
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 (Feb 11, 2019)

Hi,
Try this 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
```


----------



## fiberboysa (Feb 11, 2019)

Nope It did not worked. It game me error "Run-time error 424. Object Required"
I tried the following 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 (Feb 11, 2019)

fiberboysa said:


> Nope It did not worked. It game me error "Run-time error 424. Object Required"


What code line has been yellowed by a debugger?


----------



## ZVI (Feb 11, 2019)

I see now - there is my typo in this line .Subject = c.Offset(0, 2).Value*V*
Should be .Subject = c.Offset(0, 2).Value


----------



## fiberboysa (Feb 11, 2019)

ZVI said:


> What code line has been yellowed by a debugger?


Same line which I need to be fixed  i.e. 
	
	
	
	
	
	



```
Set .SendUsingAccount = OutApp.Session.Accounts.Item(c.Offset(0, 6).Value)
```


----------



## fiberboysa (Feb 11, 2019)

ZVI said:


> I see now - there is my typo in this line .Subject = c.Offset(0, 2).Value*V*
> 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 (Feb 11, 2019)

fiberboysa said:


> 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.


----------



## ZVI (Feb 11, 2019)

My bad, should be With CreateObject("Outlook.Application")*.CreateItem(0)
*

```
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
```


----------



## fiberboysa (Jan 22, 2019)

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.


```
[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]
```


----------



## fiberboysa (Feb 12, 2019)

If I run the above code with *.Send*, It gives me error "Run-time error '·2147221238 (8004010a)': The item has been moved or deleted."
And if i run it with *.Display* it generates all emails but close them as well instantly and in the end only last email is displayed.


----------



## ZVI (Feb 12, 2019)

It is expected  that c.Offset(0, 6).Value gets 1 or 2, please check those numbers in H-column.
Does the initial code of post 1 is working?


----------



## fiberboysa (Feb 12, 2019)

Yes there are integer values in H column i.e. 1 or 2 which are calculated by a formula.
Initial code that i posted in 1st post is working but its item value i.e. Set .SendUsingAccount = OutApp.Session.Accounts.Item(*1*) fixed to "1". I need to pic this value from column H starting from H2 and onwards...


----------



## fiberboysa (Feb 12, 2019)

BTW I modified the code in post 1 to code in post 2 so that it fulfill my needs. But its giving me error "Run-time error '5'. Invalid procedure call or argument." in line Set .SendUsingAccount = OutApp.Session.Accounts.Item(AID).


----------



## ZVI (Feb 12, 2019)

Thank you for the testing.
This should work:

```
Sub MailToDestination()
 
  Dim OutApp As Object, SendTo As String, c As Range, IsCreated As Boolean
 
  On Error Resume Next
  Set OutApp = GetObject(, "Outlook.Application")
  If Err Then
    IsCreated = True
    Set OutApp = CreateObject("Outlook.Application")
  End If
  On Error GoTo exit_
 
  For Each c In Range("B2", Range("B" & Cells.Rows.Count).End(xlUp))
    With OutApp.CreateItem(0)
      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 = OutApp.Session.Accounts.Item(c.Offset(0, 6).Value)
        .Send ' or use .Display
      End If
    End With
  Next
 
  If IsCreated Then
    OutApp.Quit
    Set OutApp = Nothing
  End If
 
exit_:
  If Err Then MsgBox Err.Description & vbLf & "Account #" & c.Offset(0, 6).Value, vbCritical, "Error #" & Err.Number
 
End Sub
```


----------



## fiberboysa (Feb 12, 2019)

Yes!!! Thank you this is working perfect...
Be blessed always.


----------



## ZVI (Feb 12, 2019)

Thank you for the feedback, 
Have a good day!


----------



## turkanet (Feb 21, 2019)

.dear zvi,
i iuse below code. i need to send mail from 3 rd accout in my outlook 2016. should i amend below codes, or change completely?

Sub BABS()
' Select the range of cells on the active worksheet.
ActiveSheet.Range("A1:E9").Select
' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = True
' Set the optional introduction field thats adds
' some header text to the email body. It also sets
' the To and Subject lines. Finally the message
' is sent.
With ActiveSheet.MailEnvelope
.Item.To = Range("F8")
.Item.Subject = Range("G8")
.Item.Send 'or use .Display
End With
'clears every X on top N after sending each mail
Columns("I:I").Find(What:="*").ClearContents
End Sub


----------



## ZVI (Feb 21, 2019)

turkanet said:


> .dear zvi,
> i iuse below code. i need to send mail from 3 rd accout in my outlook 2016. should i amend below codes, or change completely?
> 
> ...
> ...


Hi,

There is no way to choose account using MailEnvelope, you have to change method completely.
Try using code of the post #15 or the one (with default signature of the account) that I suggested to you in the another thread.

Regards


----------



## turkanet (Feb 21, 2019)

Dear ZVI,
i must sent a range ("A1:E9"), not pdf attachment. do you suggest nother way for sending a range with the other mail account?


----------



## fiberboysa (Jan 22, 2019)

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.


```
[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]
```


----------



## ZVI (Feb 22, 2019)

turkanet said:


> i must sent a range ("A1:E9"), not pdf attachment. do you suggest nother way for sending a range with the other mail account?


Try:

```
Sub SendRange_FromAccountWithItsSignatiure()
' ZVI:2019-02-22 https://www.mrexcel.com/forum/general-excel-discussion-other-questions/1084649-vba-send-email-using-account-i-want.html
 
  ' --> User settings, change to suit
  Const MyRange = "A1:E9"            ' Range to be copied into a body of email
  Const Account = *3*                  ' Index or Name of the account to send from
  ' <-- End of the settings
 
  Dim IsCreated As Boolean
  Dim OutlApp As Object, sBody As String
 
  ' Create two lines of the body's text
  sBody = "Dear Customer," & vbLf _
        & "Your data is in the below table"
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare email
  With OutlApp.CreateItem(0)
 
    ' Set HTML format
    .BodyFormat = 2
   
    ' Set the required account by const Account
    Set .SendUsingAccount = OutlApp.Session.Accounts.Item(Account)
  
    ' Prepare fields of email
    .Subject = "Report on " & Now
    .To = ""   ' <-- Put email of the recipient here
 
    ' Copy MyRange in Excel
    Application.CutCopyMode = False
    Range(MyRange).Copy
   
    ' Build the body of email
    With .GetInspector.WordEditor.Content
      .InsertBefore sBody
      With .Paragraphs(2).Range
        .Collapse 0
        .Paste
        .Paragraphs.Add
      End With
    End With
   
    ' Disable copy mode of Excel
    Application.CutCopyMode = False
 
    ' Display & send the created e-mail
    .Display
    '.Send ' <-- Uncomment this line to send
 
  End With
 
 
  ' Quit Outlook in case it was created via this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of the object variable
  Set OutlApp = Nothing
 
End Sub
```


----------



## turkanet (Feb 22, 2019)

Dear Vladimir, thank you thousands of times.


----------



## turkanet (Aug 30, 2019)

Dear Vladimir,
my macro starts like below. i added "Const Account = 2 'select account to send" line, but it again sends from default account. how can i make it send from account 2? thank you in advance

Sub Send_PDF_CUS_Draft()
' --> User settings, change to suit
Const IsDisplay As Boolean = True  ' Change to False for .Send instead of .Display
Const IsSilent As Boolean = False  ' Change to True to show Send status
Const FontName = "Candara"         ' Font name of the email body
Const FontSize = 11                ' Font size of the email body
*Const Account = 2 'select account to send*
' <-- End of the settings
Dim IsCreated As Boolean
Dim OutlApp As Object
Dim char As Variant
Dim PdfFile As String, HtmlFont As String, HtmlBody As String, HtmlSignature As String
......


----------



## ZVI (Aug 30, 2019)

turkanet said:


> ... i added "Const Account = 2 'select account to send" line, but it again sends from default account. how can i make it send from account 2?


Hi,
The *Account* is just a constant.
Choosing of the account provides this code line (see post #21):

```
' Set the required account by const Account
    Set .SendUsingAccount = OutlApp.Session.Accounts.Item(*Account*)
```
Check that this code line is present in your code, or alternatively post full the code.
Regards


----------



## turkanet (Jan 20, 2021)

Dear friends,
i need below code to STOP if there is error. Eg. if B1 is N/A.
thank you in advance for your kind comments


```
Sub SendRange_FromAccountWithItsSignatiure_Display()
' ZVI:2019-02-22 https://www.mrexcel.com/forum/general-excel-discussion-other-questions/1084649-vba-send-email-using-account-i-want.html
 
  ' --> User settings, change to suit
  Const MyRange = "A1:A21"            ' Range to be copied into a body of email
  Const Account = 3                  ' Index or Name of the account to send from
  ' <-- End of the settings
 
  Dim IsCreated As Boolean
  Dim OutlApp As Object, sBody As String
 
  ' Create two lines of the body's text
 ' sBody = "Dear Customer," & vbLf _
  '      & "Your data is in the below table"
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare email
  With OutlApp.CreateItem(0)
 
    ' Set HTML format
    .BodyFormat = 2
  
    ' Set the required account by const Account
    Set .SendUsingAccount = OutlApp.Session.Accounts.Item(Account)

    ' Prepare fields of email
    .Subject = Range("B1")
    .To = Range("C1")   ' <-- Put email of the recipient here

    ' Copy MyRange in Excel
    Application.CutCopyMode = False
    Range(MyRange).Copy

    ' Build the body of email
    With .GetInspector.WordEditor.Content
      .InsertBefore sBody
      With .Paragraphs(2).Range
        .Collapse 0
        .Paste
        .Paragraphs.Add
      End With
    End With
  
    ' Disable copy mode of Excel
    Application.CutCopyMode = False

    ' Display & send the created e-mail
    .Display
    '.Send ' <-- Uncomment this line to send
  End With

  ' Quit Outlook in case it was created via this code
  If IsCreated Then OutlApp.Quit

  ' Release the memory of the object variable
  Set OutlApp = Nothing

End Sub
```


----------



## ZVI (Jan 20, 2021)

turkanet said:


> Dear friends,
> i need below code to STOP if there is error. Eg. if B1 is N/A.


Hi, 
Use this code line - `If IsError(Range("B1").Value) Then Exit Sub` 

```
Sub SendRange_FromAccountWithItsSignatiure_Display()
 
  If IsError(Range("B1").Value) Then Exit Sub
 
  '... Other code is here ...
 
End Sub
```


----------



## turkanet (Jan 20, 2021)

Dear ZVI, thank you for your help again. mails are created successfully, but then excel file goes idle and not responding after running it. Should we add another code?


----------



## turkanet (Jan 20, 2021)

ZVI hi, could ou assist for final message?


----------

