Sending e-mails through specified account - excel

Question

When I send an assignment to students, I create an individualized file I want each student to work on. I generate the files using VBA and Excel.
I put Outlook in "Work Offline" mode so I can make sure the e-mails have the correct attachments before I put Outlook back online. I usually then hit the "send/receive all folders" button so they'll go out immediately while I'm watching.
This works at work where I have Outlook configured with just my work e-mail.
On Outlook at home (the installed app on a Windows 10 machine), I have two accounts configured.
Account #1 is a personal e-mail from a personal domain.
Account #2 is my e-mail account for work.
I want to generate e-mails like I do at work, and for them to go in the outbucket of my work account. I would then send them from there.
However, they go into the outbucket of my personal account. I don't want students to get an e-mail from an unrecognized sender. Nor do I want them replying to those e-mails.
The code to create e-mails:
Sub makemail()
Dim strLocation As String
Dim OutApp As Object
Dim OutMail As Object
Dim OutAccount As Object
Range("a1").Activate
eaddy = ActiveCell.Offset(0, 4).Value 'student's e-mail address in a worksheet
IndivFile = ActiveCell.Offset(0, 8).Value 'this is an identifier for the student's individual file
LastName = ActiveCell.Offset(0, 1).Value ' student's last name
Do Until ActiveCell.Value = ""
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set OutAccount = OutApp.Session.Accounts.Item(1)
On Error Resume Next
With OutMail
.To = eaddy
.CC = ""
.BCC = ""
.Subject = LastName & " (text that describes the assignment)"
.Body = "(body of message)"
strLocation = "(location of the individual attachments" & IndivFile & ".xlsx"
.Attachments.Add (strLocation)
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Set OutAccount = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveCell.Offset(1, 0).Activate
eaddy = ActiveCell.Offset(0, 4).Value
IndivFile = ActiveCell.Offset(0, 8).Value
LastName = ActiveCell.Offset(0, 1).Value
Loop
End Sub
It dumps the generated e-mails into the outbucket of account #1: my personal account.
I tried replacing .Send with .SendUsingAccount = OutApp.Session.Accounts.Item(2)
Putting anything in the parentheses (including a 0 or 1) will mean I don't see the output in either outbucket. (No idea if the e-mails even generated. they're probably sitting in some directory I haven't looked in.)
So, I just generated all the e-mails and they showed up in my personal account's outbucket.
I selected them all and dropped them into the outbucket of my work account.
I clicked the "send/receive" and they won't go anywhere.
If I open each e-mail individually and click the "send" button in the e-mail, they go. I see them in my sent folder.
I don't know that much about Outlook. I wonder if this is some sort of mismatched certificate problem on the e-mails? But if that were the case, why don't they go in bulk, but will go if sent individually with the e-mail open?
I just tested. if the e-mails are marked read or unread, it makes no difference.
I did set my work-email as the primary in Outlook (File > Account Settings > Designate one account as the primary one.
My questions:
Is there a way, code-wise, to put this in the second account's outbucket (work)?
Keep in mind that .SendUsingAccount = OutApp.Session.Accounts.Item(2) did not work.
If I can't do that, is there a way to change my e-mail accounts so the work one is #1?
Other than deleting and re-installing in a specific order?
I did go in and make the work-email my primary e-mail.
Why won't they send in one outbucket (because they were dragged and dropped from another outbucket), but will send if you open them individually?

Answer 1

It seems you just need to set/change the default account in Outlook.
See How To Set An Email Account As The Default Account In Outlook? for more information.
Also, you can use the SendUsingAccount property of Outlook items which sets an Account object that represents the account under which the MailItem is to be sent. The SendUsingAccount property can be used to specify the account that should be used to send the MailItem when the Send method is called.
Sub SendEmailFromAccount(ByVal application As Outlook.Application, _
ByVal subject As String, ByVal body As String, ByVal recipients As String, ByVal smtpAddress As String)
' Create a new MailItem and set the To, Subject and Body properties.
Dim newMail As Outlook.MailItem = DirectCast(application.CreateItem(Outlook.OlItemType.olMailItem), Outlook.MailItem)
newMail.To = recipients
newMail.Subject = subject
newMail.Body = body
' Retrieve the account that has the specific SMTP address.
Dim account As Outlook.Account = GetAccountForEmailAddress(application, smtpAddress)
' Use this account to send the email.
newMail.SendUsingAccount = account
newMail.Send()
End Sub
Function GetAccountForEmailAddress(ByVal application As Outlook.Application, ByVal smtpAddress As String) As Outlook.Account
' Loop over the Accounts collection of the current Outlook session.
Dim accounts As Outlook.Accounts = application.Session.Accounts
Dim account As Outlook.Account
For Each account In accounts
' When the email address matches, return the account.
If account.SmtpAddress = smtpAddress Then
Return account
End If
Next
End Function

Answer 2

Okay, found it out. Part of it depended on going to Tools > References and then making sure I've got Microsoft Outlook 16.0 Object Library is selected. Granted, you can do this without early bindings, but it seemed to help.
Here is the code I eventually came up with:
Sub makemail()
Range("a1").Activate
eaddy = ActiveCell.Offset(0, 4).Value
IndivFile = ActiveCell.Offset(0, 8).Value
LastName = ActiveCell.Offset(0, 1).Value
Dim objOutlook As Object
Dim objMail As Object
Worksheets("Rollcall").Activate
Set objOutlook = CreateObject("Outlook.Application")
Dim oAccount As Outlook.Account
Set oAccount = Outlook.Application.Session.Accounts(1)
Debug.Print oAccount
If oAccount = "outlook account you want to use" Then
Debug.Print ("condition true")
'Main Logic ============================================
Do Until ActiveCell.Value = ""
Set objMail = objOutlook.CreateItem(0)
On Error Resume Next
With objMail
.To = eaddy
'.CC = ""
'.BCC = ""
.Subject = (your subject)
.Body = "your outgoing message"
strLocation = "(location of attachment"
.Attachments.Add (strLocation)
Set .SendUsingAccount = oAccount
.Send
End With
Set objMail = Nothing
ActiveCell.Offset(1, 0).Activate
eaddy = ActiveCell.Offset(0, 4).Value
IndivFile = ActiveCell.Offset(0, 8).Value
LastName = ActiveCell.Offset(0, 1).Value
Loop
Set objOutlook = Nothing
End If
End Sub