Help in specifying a particular Outlook Email account.

[juscuz419]

I have the code below in a spreadsheet that works great EXCEPT, I have multiple Outlook Email accounts. I need to state in the VBA to use a specific Account. Any help on how to do that and where I find the correcct info to use in my outlook accounts would be greatly appreciated.

Sub CreateAndMailRosterExcel()
Dim OutApp As Object, OutMail As Object
Dim WB As Workbook, ws As Worksheet
Dim strbody As String, sEmailAddress As String, fname As String
Dim rng As Range
Dim xname As String
Dim xdate As Date

xdate = Now()
fname = "Roster for " & Format(xdate, "mm_dd_yyyy") & ".xlsx"

Set ws = ActiveSheet
Set rng = ws.Range("B5:O44")
rng.Copy
Set WB = Workbooks.Add
WB.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteAll
WB.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
WB.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteFormats
WB.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

WB.SaveAs Filename:="C:\Temp\" & fname

'Create the email object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'Compose the email
With OutMail
.To = sEmailAddress
.Subject = fname
.Body = "Attached is an Excel copy of the Roster"
.Attachments.Add WB.FullName
.Display
End With

'Clean up
Set OutMail = Nothing
Set OutApp = Nothing
WB.Close SaveChanges:=False
'Kill "C:\Temp\" & fname
Set WB = Nothing
Set ws = Nothing
End Sub

 

[DanteAmor]

Try this.

After this line:

With OutMail

Add this line:

.SendUsingAccount = OutApp.Session.Accounts.Item(1)

Change the item number to your email account number.


To know the item number of each of your accounts run this macro:

Sub MailAccounts()
  Dim OutApp As Object
  Dim i As Long
  Dim sAcc

  Set OutApp = CreateObject("outlook.application")
  For i = 1 To OutApp.Session.Accounts.Count
    sAcc = sAcc & i & vbTab & OutApp.Session.Accounts.Item(i) & vbCr
  Next
  MsgBox sAcc
End Sub

It will show you a msgbox with the item number and email account: