VBA Send Email from Second Outlook Email Address - vba

I am using the following code to send emails through Outlook using VBA in Excel. I have two emails addresses set up in Outlook. I'd like to send the email from my secondary email account. How would I do that?
Dim objOL
Dim objAppt
Const olAppointmentItem = 1
Const olMeeting = 1
Set objOL = CreateObject("Outlook.Application")
Set objAppt = objOL.CreateItem(0)
With objAppt
.display
End With
signature = objAppt.HTMLBody
With objAppt
.to = Range("H3").Value
.Subject = Range("L3").Value
.CC = Range("K3").Value
.HTMLBody = Body
.display 'display not send
End With
Set objAppt = Nothing
Set objOL = Nothing

Set the MailItem.SendUsingAccount property to one of the Account objects from the Namespace.Accounts collection.

Related

Put email addresses stored in an array into "To" field of an Outlook email

I want email addresses that are stored in the array "emails" put into the "To" part of an email.
I get a type mismatch error.
Sub Email_Click()
Dim myOutlook As Outlook.Application
Dim objMailMessage As Outlook.MailItem
Dim emails As Variant
emails = Array("a#a.com", "b#b.com")
Set myOutlook = Outlook.Application
Set objMailMessage = myOutlook.CreateItem(0)
With objMailMessage
.Display
.To = emails
.Subject = ""
.HTMLBody = ""
.Save
.Close olPromptForSave
End With
End Sub
To close this question out, use Join:
.To = Join(emails, ";")

Send Outlook email with attachment using Excel VBA

I am trying to send email with attachment using Excel VBA.
My code is sending email if I am not including the attachment code line.
When I write that line to send an attachment it is showing error.
Set MyApp = CreateObject("Outlook.Application")
Set MyItem = MyApp.CreateItem(0)
With MyItem
.To = "saurabh.ad.sharma#accenture.com"
.Subject = "Subject"
.ReadReceiptRequested = False
.HTMLBody = "resport"
.Attachment = "C:\Users\saurabh.ad.sharma\Desktop\rrr.xlsx"
End With
MyItem.Send
A simple example to send mail with attachment
try this out
Dim objOutl
Set objOutl = CreateObject("Outlook.Application")
Set objMailItem = objOutl.CreateItem(olMailItem)
'comment the next line if you do not want to see the outlook window
objMailItem.Display
strEmailAddr = "me.me#you.com"
objMailItem.Recipients.Add strEmailAddr
objMailItem.Body = "Hi"
objMailItem.Attachments.Add "file.xml"
objMailItem.Send
Set objMailItem = nothing
Set objOutl = nothing

Macro doesn't show open mail

Below is my macro to send an email but it does not open a new email .
This macro is in the outlook rules.
Have you any ideas?
Sub sendemail()
Dim ns As NameSpace
'Dim newMail As Outlook.MailItem
Set ns = GetNamespace("MAPI")
Dim newMail As MailItem
Set newMail = Application.CreateItem()
With newMail
.To = "aaa#bbb" <--adress to whitch I want to send an email
.Subject = "test"
.Display
End With
Set newMail = Nothing
End Sub
first you need to add up the outlook reference:
There you go:
then:
Sub sendemail()
Dim outlook As New outlook.Application
Dim newMail As outlook.MailItem
Set newMail = outlook.CreateItem(olMailItem)
With newMail
.To = "email#address.com" ' <--adress to whitch I want to send an email
.Subject = "test from Steph"
.Display
.Send
End With
Set newMail = Nothing
outlook.Quit
Set outlook = Nothing
End Sub
Argument must be type MailItem or MeetingItem for the subroutine to be available in Outlook Rules Wizard.
Try this.
Option Explicit
Sub SendEmail(NewMail As Outlook.MailItem)
Set NewMail = Application.CreateItem(olMailItem)
With NewMail
.To = "aaa#bbb" '<--adress to whitch I want to send an email
.Subject = "test"
.Display
End With
Set NewMail = Nothing
End Sub
Youre not specifying the item to create. See here:
Private Sub SendEmail(ByVal workcenter As Integer, ByVal time As Date)
Dim objApp As Object
Dim objEmail As Object
Set objApp = CreateObject("Outlook.Application")
Set objEmail = CreateObject("Outlook.MailItem")
With objEmail
.To = "emailexampe#website.com"
.Subject = "Multiple Shop Orders run for line " & workcenter & " at " & time
.body = "TEST"
.display
End With
Set objEmail = Nothing
Set objApp = Nothing
End Sub
Source: http://www.vbforums.com/showthread.php?536558-RESOLVED-Outlook-late-binding
this version also uses late binding, so you dont need any additional references.

How to loop sending emails

I have a folder test that contains the following files user1.xlsx , user2.xlsx , user3.xlsx
In my working spreadsheet work.xlsx i have corresponding addresses
user1.xlsx user1name#gmail.com
user2.xlsx user2name#yahoo.com
...
How can I send emails with the attached user1 , user2 .xlsx files to corresponding emails
'Email
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 = userVar
.SentOnBehalfOfName = "xxxx"
.CC = ""
.BCC = ""
.Subject = "...
.Body = "...
.Attachments. .. ??
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'Close
Have you reviewed this MS KB? It details the VBA for sending an email as below:
Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Nancy Davolio")
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Michael Suyama")
objOutlookRecip.Type = olCC
' Add the BCC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "This is the body of the message." &vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each ObjOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub
Notice that you have to Set the objOutlookAttach using the AttachmentPath, which would be the same as the location of your file (hardcode or use current directory as path). Your loop should be for each email address in a specified range, grab the corresponding filename (from adjacent cell), append it to the AttachmentPath variable, and then used to set the objOutlookAttach.
UPDATE: a more up-to-date, related MS article can be found here for additional reference and guidance.

VBA Outlook Mail .display, recording when/if sent manually

My code displays a message with basic subject, body, attachment. Next the user manually updates and customizes the message and should send it. I want to record when (if) the email is sent. Is this possible or any tips?
My environment is Office 2007 with an excel based macro going to Outlook.
[Excerpt]
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = Email '.CC =
.Subject = Subj
.BodyFormat = olFormatHTML
.Body = Msg '.HTMLBody = Msg
If Not FileAttach = vbNullString Then .Attachments.Add (FileAttach)
.Display
End With
This is entirely possible, using the _Send event in the Outlook.MailItem class.
The way I use it, I create a class called EMail Watcher, so when I create the email and do the .Display, I then create a new EMailWatcher object and tell it to watch that email for send, then report back when it happens.
Here's the class as I use it. Basically, I also optionally can set the BoolRange so that if the user sends the email, that Excel range gets updated with True. I can also have the class update an Excel range with the time the email is sent.
Public BoolRange As Range
Public DateRange As Range
Public WithEvents TheMail As Outlook.MailItem
Private Sub TheMail_Send(Cancel As Boolean)
If Not BoolRange Is Nothing Then
BoolRange.Value = True
End If
If Not DateRange Is Nothing Then
DateRange.Value = Now()
End If
End Sub
And here's how I use it:
With oMail
.To = addr
.Subject = "CCAT eVSM Utilities License Code"
.Body = "Message body"
.Display
End With
Set CurrWatcher = New EmailWatcher
Set CurrWatcher.BoolRange = Range("G12")
Set CurrWatcher.TheMail = oMail
Hopefully that helps...