Sending Emails with Outlook 2013/Excel 2013 - vba

I currently have a program that queues up emails to send in a spreadsheet and then sends them out through the Outlook application (Excel and Outlook are both 2013 versions).
When I run the program, it goes through without a problem, however when a coworker runs the program they continue to get the prompts that "A program is trying to send a message on your behalf" and then they have to allow or deny each one individually.
I have looked through different methods for addressing this from changing the registry (tried that and it did not change anything) to security settings (still nothing).
Is there a way to address this with VBA?
The current code is:
Sub SendEmail(what_address As String, subject_line As String, mail_body_message As String)
Dim olApp As Outlook.Application
Dim oAttach As Outlook.Attachment
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = "ADDRESS"
.Subject = "SUBJECT"
.BodyFormat = olFormatHTML
.HTMLBody = mail_body_message
'.CC = "EMAIL"
.BCC = ""
.Importance = olImportanceHigh
.ReadReceiptRequested = True
.Send
End With
End Sub
Thanks!

From Ron's site instead of .Send
.Display
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
This will just bring up the email and sendkeys Alt-S to send.

Related

How to create a mailitem?

I'm trying to send the active Excel workbook as an attachment via Outlook.
Whenever I run the code it says
Invalid use of New key word
at New Outlook.MailItem`.
Sub SendOutlook()
'Declaring Variables
Dim OutlookApp As Outlook.Application
Dim OutlookEmail As Outlook.MailItem
'Assigning variables to create outlook application and mailitem
Set OutlookApp = New Outlook.Application
Set OutlookEmail = New Outlook.MailItem
With OutlookEmail
'Format of the mail
.BodyFormat = olFormatPlain
'Body of the mail
.Body = "Dear Someone" & vbNewLine & "How are you?"
'To whom you want to send mail
.To = "Someone#somewhere.com"
'Subject of mail
.Subject = "Write Subject Here"
'TO add an attachment
.Attachments.Add ActiveWorkbook.FullName
'sends the mail
.Send
End With
End Sub
You cannot create a MailItem via New. It must be created using CreateItem of the the Outlook Application Object.
Set OutlookApp = New Outlook.Application
Set OutlookEmail = OutlookApp.CreateItem(olMailItem)
As far as I got to know from the research is that Programmatic access to sending emails is a security risk, so it's not allowed via VBA.
You can use a programmatic approach with the following:
Option Explicit
Private outlook_app As Object
Private outlook_mailItem As Variant
Sub send_email()
Set outlook_app = CreateObject("Outlook.Application")
With outlook_app.CreateItem(outlook_mailItem)
.To = "Someone#somewhere.com"
.Subject = "Write Subject Here"
.Body = "Dear Someone" & vbNewLine & "How are you?"
.send
End With
Set outlook_app = Nothing
End Sub

Sending Email with attachment by MS-Outlook in VBA, Excel when Outlook is closed

When I send mail free from attachment, works truly.
But when I using the .Attachments.Add ActiveWorkbook.FullName parameter, it does not send and been pending to opening Outlook.
I want send mails when outlook is closed.
I'm using below code:
Sub SendMail()
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.To = "address#domain.com"
.CC = ""
.BCC = ""
.Subject = "M"
.BodyFormat = olFormatHTML
.HTMLBody = "Hi, <p> I'm sending this message from Excel using VBA.</p>Please find <strong> M</strong> in life."
.Attachments.Add ActiveWorkbook.FullName
.DeferredDeliveryTime = DateAdd("n", 1, Now)
.Importance = olImportanceHigh
.ReadReceiptRequested = True
.Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
About .DeferredDeliveryTime = DateAdd("n", 1, Now): I want the email have send 1 minutes after running the macro.
Regards.
Reasons for why this question is unique:
StackowerflowQuestion: Here the problem is solved in my above code and the remained problem is sending attachment that I focused on here. and the appropriated answer is what I accent about is Outlook is closed.
Update
Another symptom is when I running above code an temporal Icon will shown in the try system with a popup message: "another program is using outlook. to disconnect program and exit outlook...".
Please also consider this, if important.
Please note that the problem is sending attachment.
With above code, the problem of sending email when outlook is closed was solved. (that mentioned in similar question)
So the remained problem is sending attachment in this case (Outlook is closed).
Sorry, I misinterpreted your question just now. With reference to here, you need to add the following code.
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
End If
On Error Goto 0
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "address#domain.com" ' continue from here

How to add a Signature on Excel

I have an Excel spreadsheet Auditing Vendor documentation with expiry dates.
I have created an VBA macro which when I choose (Ctrl + M) will send an email requesting updates for specific documents based on the expiry dates.
Everything is beautiful and works like a charm.
My question is how do I include an Outlook Signature at the end of the email?
I would like it to pick up based on whoever has the spreadsheet open so that if Charlie Brown wants to trigger an email it would include Charlie Brown's Signature at the end.
It already auto-fills Charlie Brown as the Sender so I should be able to do this.
Any suggestions?
Here is an Example
Option Explicit
Sub AddSignature()
Dim olApp As Object
Dim olMail As Object
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(0)
With olMail
.Display olMail.HTMLbody '<- adding default signature
End With
With olMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.HTMLbody = "Hello." & "<br>" & .HTMLbody '<- adding default signature
.Display
' .Send
End With
Set olMail = Nothing
Set olApp = Nothing
End Sub
also see Insert Signature in mail From Ron de Bruin
If you use excel to grab the new mail item signature you will get a flag for suspicious activity that the user could acknowledge
Dim OApp, OMail As Object
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
Dim sig As String
sig = OMail.HTMLbody
If you know the name of the signature you can go browse for it
Dir (CStr(Environ$("userprofile")) & "\appdata\roaming\microsoft\signatures\")

Send an email from a group email address in outlook using VBA

I currently want to build a VBA function that enables people to send emails using a group email address(e.g. person A has an email address a#111.com and he is also a member of "student" group and has access to send emails using the groups email address student#111.com)
I am thinking about using a VBA to build such a function. It is easy to construct body, recipient and etc. but how to shift the sender i.e. from field to the group email address?
Did you want any more than just how to send it? I'm slightly confused by your question.
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it. Or pass variables to it
With OutMail
.To = "tom#google.com" 'You can also set it equal to something like TextBox1.Text or any string variable or item
.CC = ""
.BCC = ""
'Once again for the next two you can pull this from a cell, a textbox, or really anything
.Subject = "This is the Subject line"
.Body = "Hello World!"
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Maybe you just need to edit the reply-to address so that any replies get sent to the group?
Here's how, using Outlook:
'Tools > References ... > check "Microsoft Outlook object library"
Dim outlookApp As Outlook.Application
Dim mailMsg As MailItem
Dim replyToRecipient As Recipient
Set outlookApp = CreateObject("Outlook.Application")
Set mailMsg = outlookApp.CreateItem(olMailItem)
With mailMsg
.To = "abc#111.com"
Set replyToRecipient = .ReplyRecipients.Add("group#111.com") ' group adderss
replyToRecipient.Resolve
If Not replyToRecipient.Resolved Then Err.Raise 9999, , _
replyToRecipient.Address _
& " could not be resolved as a valid e-mail address."
'...
'... edit body etc. here...
'...
.Display
End With

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