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

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

Related

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\")

VBA outlook - send email and categorize the CC email

I have been using public folder and sending emails on outlook. Whenever we send emails with the public folder email address (e.g info#company.com), we will CC info#company.com. So that we will keep the email in our public folder.
I have created some VBA code to send outlook email automatically.
My question is: Is it possible to automatically categorize (e.g. customer-inquiry) the email in our public folder when I send the email without showing the category to recipient (as .
Sub outlookActivate1()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
With OutMail
.BCC = ""
.BodyFormat = olFormatHTML
.Categories = "customer-inquiry"
.ShowCategoriesDialog
.Save
.display
End With
On Error GoTo 0
Set OutMail = Nothing
Set oItem = Nothing
End Sub
No, it is not. You may consider adding a user property to the mail item instead. See UserProperties for more information.

Sending Emails from Excel VBA - Names Not Recognized

I am using the below code to send an email from excel using outlook:
Private Sub SendEmail()
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)
newmsg.Recipients.Add ("name#domain.com; name2#domain.com; name3#domain.com")
newmsg.Subject = "Test Mail"
newmsg.Body = "This is a test email."
'newmsg.Display
newmsg.Send
End Sub
The code works just fine, however I get the below error from Outlook when trying to send the email:
ErrorScreen http://im58.gulfup.com/GRENlB.png
The strange thing is that if I leave the new message open for two or three minutes the names automatically get resolved:
Working http://im74.gulfup.com/qmOYGQ.png
However this doesn't suit me as I don't want the message to be displayed before it's sent. I am looking to have it send as soon as I run the code.
Any suggestions or workarounds will be appreciated.
As a side note: I have tried enabling the "Allow commas as email separators" option in outlook, and then using the commas instead of the semicolons, but I am still facing the same problem.
UPDATE:
Below is the working code, as per Dmitry Streblechenko's answer:
Private Sub SendEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OlObjects = OutApp.GetNamespace("MAPI")
Set OutMail = OutApp.CreateItem(olMailItem)
On Error Resume Next
With OutMail
.To = ("name#domain.com; name2#domain.com; name3#domain.com")
.Subject = "Test Mail"
.Body = "This is a test email."
'.Display
.Send
End With
End Sub
You cannot pass multiple names to Recipients.Add - you get a single recipient with the name of "name#domain.com; name2#domain.com; name3#domain.com". Either call Recipients.Add 3 times once for each recipient or set the To property - it will parse multiple names.
You should add a call to ResolveAll to explicitely resolve all recipients.
Otherwise, resolution is done automatically after a short waiting period.
Example:
Sub CheckRecipients()
Dim MyItem As Outlook.MailItem
Dim myRecipients As Outlook.Recipients
Dim myRecipient As Outlook.Recipient
Set myItem = Application.CreateItem(olMailItem)
Set myRecipients = myItem.Recipients
myRecipients.Add("Aaron Con")
myRecipients.Add("Nate Sun")
myRecipients.Add("Dan Wilson")
If Not myRecipients.ResolveAll Then
For Each myRecipient In myRecipients
If Not myRecipient.Resolved Then
MsgBox myRecipient.Name
End If
Next
End If
End Sub
Code copied from here.

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