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:

 

[juscuz419]

Had to go do some volunteer work following the snow storm. I applied this fix to MY use of the spreadsheet and it works great. I have about a dozen folks that use the spreadsheet that are way less comfortable (and literate) with computers than I am (which isn't saying much). I tried to SET the out mail Sender address using the code below. It opens Outlook, with the correct sender address in the FROM field, creates and attaches the file, but when the SEND command is given, I get SYSTEM ADMINISTRATOR error message saying that the email recipient is not reachable. Can you identify the problem with the code OR suggest a way to set the senders email address within the code?

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
Dim senderAddress As String

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

Set ws = ActiveSheet
Set rng = ws.Range("B6:AA300")
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
'Set the "From" address
senderAddress = "MrBojangles@mail.com" ' Replace with desired sender email address
OutMail.SentOnBehalfOfName = senderAddress

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

The sEmailAddress variable is empty, at no time do you put a recipient in it.
Give an example:

After this line:
OutMail.SentOnBehalfOfName = senderAddress

Put this line:
sEmailAddress = "email2@gamil.com" 'change by recipient

 

[juscuz419]

If you comment out the code above that is red font and run the macro, it does everything correctly. Creates the WB, opens Outlook with the WB as an attachment, Fills the body of the email and has the cursor at the TO: location for the user to enter the email address of where to send it. I've had that part working as desired for a while. I am trying to add the ability to specify in the Outmail section a specific sender email address.

 

[DanteAmor]

Outmail section a specific sender email address.

I tried your code and it works, just check that senderAddress is a valid email.