VBA - Send An Email Using Account That I Want

[fiberboysa]

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]

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]

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]

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]

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]

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]

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

 

[ZVI]

Thank you for the feedback,
Have a good day!

 

[turkanet]

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

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

...
With ActiveSheet.MailEnvelope
...

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]

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?