How can I send from a secondary Outlook account using Excel VBA?
With OutMail
.to = Text(1)
.CC = Text(2)
.BCC = ""
.Subject =text(3)
.HTMLBody = Text(10)
.Display '.send
End With
I tried ".from".
The below is from a pretty all-purpose sub I use to send emails from VBA.
It takes three parameters:
OutApp is an Outlook.Application object
SendFromAddress is a string variable containing the address to send from
OutMail is the current mailitem object, which you already have as a variable looking at your code.
'Sender Address
If Len(SendFromAddress) > 0 Then
'if directly signed into the account:
For a = 1 To OutApp.Session.accounts.Count
If LCase(OutApp.Session.accounts.Item(a)) Like LCase(SendFromAddress) Then
Outmail.sendusingaccount = OutApp.Session.accounts.Item(a)
SendFromAddress = ""
Exit For
End If
Next
'If not directly signed in (shared mailbox):
If Len(SendFromAddress) > 0 Then Outmail.SentOnBehalfOfName = SendFromAddress
End If
Related
The code works. Outlook crashes for large data.
Turning off .Display may solve the crash problem.
Disabling .Display does not allow Word content to be copied to Outlook body.
Is there any other way, Word content will be copied to email body with .Display turned off? Emails will be generated in the background.
Sample Excel Photo
Sub WordContent_to_EmailBody()
'On Error Resume Next
Dim o As Outlook.Application
Set o = New Outlook.Application
Dim omail As Outlook.MailItem
Dim wd As Word.Application
Dim doc As Word.Document
Set wd = New Word.Application
wd.Visible = True
' *Word Document Template File getting pulled from cell reference*
Set doc = wd.Documents.Open(Cells(1, 2).Value)
Dim i As Long
For i = 4 To 7 ' *Large data loop 4 To 1004 then outlook crashes at 100+*
Set omail = o.CreateItem(olMailItem)
With wd.Selection.Find
.Text = "<<Client>>"
.Replacement.Text = Sheet1.Cells(i, 1).Value
.Execute Replace:=wdReplaceAll
End With
With wd.Selection.Find
.Text = "<<Remarks>>"
.Replacement.Text = Sheet1.Cells(i, 2).Value
.Execute Replace:=wdReplaceAll
End With
doc.Content.Copy ' *Full Word Document Content copied for outlook body*
'Want to turn off `.display` because it crashes outlook for more than 100+
' emails with attachment size more than 500kb. On the other hand, without
' `.display` Word content copy paste dose not work
With omail
.Display
.To = Cells(i, 3).Value
.CC = Cells(i, 4).Value
.Subject = Cells(i, 5).Value
.Attachments.Add Cells(i, 6).Value
Set Editor = .GetInspector.WordEditor
Editor.Content.Paste
.Send ' *Word Content getting Paste to email body and being sent*
End With
Documents("Survey_Outlook.docx").Undo 2
Next i
doc.Close saveChanges:=False
MsgBox "Finish - Check the Generated email in Outlook - OUTBOX FOLDER > Offline Work <"
End Sub
I'd suggest using the HTMLBody property without involving the Word object model for setting up the message bodies. You can construct the HTML markup based on the Office documents on your own and then just set the single property - HTMLBody. That doesn't require the Display method to be used before submitting items.
Also you may consider using a low-level API on which Outlook is built on - Extended MAPI or just any other wrappers around that API such as Redemption.
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?
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
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
I've spent the last couple days trying to figure this out, I've managed to stop all the errors, however the email doesn't show up in my inbox. I've tried to change everything up and still it doesn't show up.
The main purpose is to send an entire workbook to an email with a button (I've binded the button to the macro)
Anyways, here's the code I have already
Sub Send_mail()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "example#email.com"
.From = "example#email.com"
.CC = ""
.BCC = ""
.Subject = "Assunto"
.Body = "Corpo"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
(ps I did change the email to post this, it's not what I have in the code)
Please remove .From = "example#email.com"
Mail will go with attachment from outlook default mail address.
In Microsoft Documentation From is not listed while To, cc, BCC etc are included . So syntax wise it is wrong. It works for me after removing .From
You can see from list below
Methods
Properties
Actions
AlternateRecipientAllowed
Application
Attachments
AutoForwarded
AutoResolvedWinner
BCC
BillingInformation
Body
BodyFormat
Categories
CC
Class
Companies
Conflicts
ConversationID
ConversationIndex
ConversationTopic
CreationTime
DeferredDeliveryTime
DeleteAfterSubmit
DownloadState
EntryID
ExpiryTime
FlagRequest
FormDescription
GetInspector
HTMLBody
Importance
InternetCodepage
IsConflict
IsMarkedAsTask
ItemProperties
LastModificationTime
MarkForDownload
MessageClass
Mileage
NoAging
OriginatorDeliveryReportRequested
OutlookInternalVersion
OutlookVersion
Parent
Permission
PermissionService
PermissionTemplateGuid
PropertyAccessor
ReadReceiptRequested
ReceivedByEntryID
ReceivedByName
ReceivedOnBehalfOfEntryID
ReceivedOnBehalfOfName
ReceivedTime
RecipientReassignmentProhibited
Recipients
ReminderOverrideDefault
ReminderPlaySound
ReminderSet
ReminderSoundFile
ReminderTime
RemoteStatus
ReplyRecipientNames
ReplyRecipients
RetentionExpirationDate
RetentionPolicyName
RTFBody
Saved
SaveSentMessageFolder
Sender
SenderEmailAddress
SenderEmailType
SenderName
SendUsingAccount
Sensitivity
Sent
SentOn
SentOnBehalfOfName
Session
Size
Subject
Submitted
TaskCompletedDate
TaskDueDate
TaskStartDate
TaskSubject
To
ToDoTaskOrdinal
UnRead
UserProperties
VotingOptions
VotingResponse
Can I use mailitem.entryID in Excel VBA?
I have a tool using excel where I can send an outlook email to recipients using spreadsheet as the UI to display user data. I need to store the entryID of each of the emails send to the user in the excel table. Can I set in the code (excel vba) mailitem.entryID = worksheet.cells().value ? Will it retrieve the entryID? Can you give me your input regarding this? Thank you for your help.
Dim AppOutlook As Object
Dim MailOutlook As Object
Dim Emailto, ccto, sendfrom As String
Set AppOutlook = CreateObject("Outlook.Application")
Set MailOutlook =AppOutlook.CreateItem(0)
Emailto = worksheet.Cells().Value
ccto = worksheet.Cells().Value
sendfrom = "email"
With OutMail
.SentOnBehalfOfName = sendfrom
.To = Emailto
.CC = ccto
.BCC = ""
.Subject =
.BodyFormat = olFormatHTML
.HTMLBody = "body here"
.Send
This is my code, and I plan to add the code worksheet.cells.value = MailOutlook.entryID at the last line of the code. Is it possible? and where to add the AddItem event?
You can read the EntryID property after the message is sent. You cannot do that before or immediately after sending the message - it will be changed when the message is asynchronously sent and moved to the Sent Item folder. The erliest you can access the entry id in the Sent Items folder is when the Items.ItemAdd event fires in the Sent Items folder.
The mail item may not exist any longer after calling the Send method. It can be moved to the Outbox folder for further processing by the transport provide. Item can be marked for processing by the transport provider, not being yet sent. So, we need to handle the ItemSend event in the code.
If you need to be sure that the mail item was sent for sure I'd recommend handling the ItemAdd event of the Items class (see the corresponding property of the Folder class). For example, when an Outlook item is sent, a sent copy is placed to the Sent Items folder in Outlook. You may handle the ItemAdd event for that folder to be sure that the item was sent for sure. Consider adding a user property before displaying the Outlook item and checking it in the ItemAdd event handler to identify the item uniquely.
Demo code based on your code:
Sub Test3()
Dim AppOutlook As Object
Dim MailOutlook As Object
Dim Emailto, ccto, sendfrom As String
Set AppOutlook = CreateObject("Outlook.Application")
Set MailOutlook = AppOutlook.CreateItem(0)
Emailto = Worksheets("Sheet3").Cells(1, 1).Value
ccto = Worksheets("Sheet3").Cells(2, 1).Value
sendfrom = "test#outlook.com"
With MailOutlook
.SentOnBehalfOfName = sendfrom
.To = Emailto
.CC = ccto
.BCC = ""
.Subject = "Test"
.BodyFormat = olFormatHTML
.HTMLBody = "body here"
'.Display
.Send
End With
End Sub
Some ItemAdd snippet for you reference(The current event is not the right one, we still need to test it):
Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items
‘Private Sub Application_Startup()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim objWatchFolder As Outlook.Folder
Dim AppOutlook As Object
Set AppOutlook = CreateObject("Outlook.Application")
Set objNS = AppOutlook.GetNamespace("MAPI")
'Set the folder and items to watch:
Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox)
Set objItems = objWatchFolder.Items
Set objWatchFolder = Nothing
End Sub
Private Sub objItems_ItemAdd(ByVal Item As Object)
' Your code goes here
MsgBox "Message subject: " & Item.Subject & vbcrlf & "Message sender: " & Item.SenderName &" (" & Item.SenderEmailAddress & ")"
Worksheets("Sheet3").Cells(3, 1).Value = Item.EntryID
Set Item = Nothing
End Sub
The MailItem object is part of Outlook's VBA Object library. You can see the documentation for the MailItem object on MSDN here.
To use VBA objects from a different program in Microsoft Office (eg. calling Outlook from Excel, calling Visio from Word, calling Excel from Powerpoint) you first need to make sure you have the right References selected in your Visual Basic Editor (VBE).
How to turn on Outlook references in Excel:
In Excel's VBE, go to Tools > References.
A References - VBAProject box will appear.
Under Available References: scroll down until you reach something like Microsoft Outlook 16.0 Object Library (This will differ depending on the version of Office you are using)
Tick the box and press OK.
Now the Outlook Object references have been enabled, you should be able to call Outlook objects and methods from Excel, including MailItem.
I'm using the below code to auto-generate an email.
Public Function GenerateEmail(sendToText As String, _
sendCCText As String, sendBCCText As String, _
subjectText As String, fileName As String)
Application.ScreenUpdating = False
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate(fileName)
With OutMail
.sendTo = sendToText
.CC = sendCCText
.BCC = sendBCCText
.Subject = subjectText
.HTMLbody = WorksheetFunction.Substitute(OutMail.HTMLbody, "%TESTNUM%", "98541")
.Attachments.Add (Application.ActiveWorkbook.FullName)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Function
My end goal is to add data into the email and attach the active document into it as well. Everything here is working as intended, except the .HTLMbody section. It's giving me an error
"Unable to get the Substitute property of the WorksheetFunction
class."
Am I missing a reference to a library? Should I be using something different?
The email is saved as .oft format, so I have a line in the email that has %TESTNUM% that I'm looking to replace with 98541 (or any other string I need to pass into the function)
I have HTML email working in Excel using very similar code. The difference is that I build a temporary string with the text and you could do your substitute code on the string.
Then you can simply use:
.HTMLbody = temp_string
It might not be as elegant but it will help you work out where the problem is.