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]

 

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

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]

Dear Vladimir, thank you thousands of times.

 

[turkanet]

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]

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

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]

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]

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]

ZVI hi, could ou assist for final message?