When sending an email, I want to search the recipients of the email as well as the email body for certain key works, and if found, pop up a message to confirm sending.
I am able to get a pop up when the user hits the send key. I'm unable to access the recipient or message objects to search them.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim xPrompt As String
Dim xOkOrCancel As Integer
On Error Resume Next
xPrompt = "Do you want to continue sending the email?"
xOkOrCancel = MsgBox(xPrompt, vbOKCancel)
If xOkOrCancel <> vbOK Then
Cancel = True
End If
End Sub
I added the following code to try to see the recipient, but it is not returning anything.
Set myAddressEntry = myRecipient.AddressEntry
xPrompt = Trim(myAddressEntry)
xOkOrCancel = MsgBox(xPrompt, vbOKCancel)
You are passing a COM object to a function that expects a string. More than that, you don't need the Recipient.AddressEntry property, just work with the Recipient object since it is resolved.
xPrompt = Trim(myRecipient.Name)
I assume you correctly initialize the myRecipient object from the Item.Recipients collection.
Related
I want a warning every time I try to send an email outside my company, where external email addresses are those that don't end in the mycompany.com domain.
This prompts every time I send an email, regardless of the recipient or recipients.
It should only prompt if at least one of the to/cc/bcc recipients has an email address with a different domain.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim xMailItem As Outlook.MailItem
Dim xRecipients As Outlook.Recipients
Dim i As Long
Dim xRecipientAddress As String
Dim xPrompt As String
Dim xYesNo As Integer
Dim xPos As Integer
On Error Resume Next
If Item.Class <> olMail Then Exit Sub
Set xMailItem = Item
Set xRecipients = xMailItem.Recipients
For i = xRecipients.Count To 1 Step -1
xRecipientAddress = xRecipients.Item(i).Address
xPos = InStrRev(LCase(xRecipientAddress), "#mycompany.com")
If xPos <= 0 Then Exit For
Cancel = False
Next
If InStrRev(LCase(xRecipientAddress), "#mycompany.com") > 0 Then Exit Sub
xPrompt = "Are you sure you want to send this email outside of The Company?"
xYesNo = MsgBox(xPrompt, vbYesNo + vbQuestion, "External Email Warning")
If xYesNo = vbNo Then Cancel = True
End Sub
The Recipient.Address may not return an SMTP email address in case of Exchange accounts. Microsoft Exchange Server can operate with email address types such as Exchange, SMTP, X.400, Microsoft Mail, etc. By default, the Address property of the Recipient class returns just an Exchange type address, for example this one:
/O=ORGANIZATION_NAME /OU=EXCHANGE_GROUP /CN=RECIPIENTS /CN=USER_NAME
To get other address types, we need to find the recipient in the Outlook address book by using the IAddrBook.ResolveName method, then reach the IMailUser interface with the IAddrBook.OpenEntry method and get the PR_EMS_AB_PROXY_ADDRESSES property. Read more about that in the HowTo: Convert Exchange-based email address into SMTP email address article.
Also you may consider using the AddressEntry property of the Recipient class return an object which represents a person, group, or public folder to which the messaging system can deliver messages. You can check out the AddressEntry.AddressEntryUserType property which returns a constant from the OlAddressEntryUserType enumeration representing the user type of the AddressEntry. In case of Exchange entry you need to use the following sequence of property and method calls:
Recipient.AddressEntry.GetExchangeUser().PrimarySmtpAddress
The ExchangeUser.PrimarySmtpAddress property returns a string representing the primary Simple Mail Transfer Protocol (SMTP) address for the ExchangeUser.
I think this logic is easier to follow. I believe InStr is sufficient.
Option Explicit
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim xMailItem As MailItem
Dim xRecipients As Recipients
Dim i As Long
Dim xRecipientAddress As String
Dim xPrompt As String
Dim xYesNo As VbMsgBoxResult
Dim xPos As Long
If Item.Class <> olMail Then Exit Sub
Set xMailItem = Item
Set xRecipients = xMailItem.Recipients
For i = xRecipients.count To 1 Step -1
xRecipientAddress = xRecipients.Item(i).Address
Debug.Print xRecipientAddress
' Use text from internal xRecipientAddress
xPos = InStr(LCase(xRecipientAddress), "#mycompany.com")
Debug.Print xPos
If xPos = 0 Then
xPrompt = "Are you sure you want to send this email outside of The Company?"
xYesNo = MsgBox(xPrompt, vbYesNo + vbQuestion, "External Email Warning")
If xYesNo = vbNo Then Cancel = True
Exit For
End If
Next
End Sub
At our company, we use Outlook Exchange Desktop edition. Some of us have multiple accounts to send/receive emails from. I have created a VBA macro to check for each email when pressing the Send button what account they are sending the mail from, and then to create a handler that checks if this mail arrives in the "Sent items" folder. After arriving it takes this mail and saves it to a predefined folder.
At first I created this macro to only work with the default account and default folder for sent mail. It worked perfectly. Now I added some code to check the account it is sent from in the correct "Sent items" folder (the one of the correct account). Therefore I used the MailItem.SendUsingAccount property.
When applying this macro, 8 out of 10 times, I get the correct account and the macro works fine. The other 2 times, the SendUsingAccount property return "Null" or "Nothing" (I don't know the difference between these two). I found an other thread here where another user suggests the assignment of accounts to Mailitems is not always reliable, but it doesn't state a proper solution to my problem. Why do I sometimes get nothing as a returnvalue and other times it works perfectly fine? When it's not working, it's always about the code line: ZendAcc = Item.SendUsingAccount. Here the ZendAcc variable cannot store the empty SendUsingAccount return.
VBA:
Public WithEvents myOlItems As Outlook.Items
'Sub triggered when pressing the send button in outlook email
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim ZendAcc As String
'Checking for multiple accounts
If Application.Session.Accounts.Count > 1 Then
'Check if the itemtype is MailItem. (normally it will always be correct)
If TypeName(Item) <> "MailItem" Then
MsgBox "There is no MailItem"
Exit Sub
Else
'Store AccountName in String
ZendAcc = Item.SendUsingAccount
If ZendAcc = "" Then
Exit Sub
End If
'Create the handler and give it the Accountname String
Call Initialize_handler(ZendAcc)
End If
Else
'When there is only one account, the Accountname doesn't matter, but you need a String
Call Initialize_handler("Useless")
End If
End Sub
Public Sub Initialize_handler(ByVal zendAccount As String)
Dim Store As Store
Dim Folder As Folder
'If there are multiple accounts, check for the right sent mails folder, otherwise use the default one.
If Application.Session.Accounts.Count > 1 Then
For Each oAccount In Application.Session.Accounts
If oAccount.SmtpAddress = zendAccount Then
Set Store = oAccount.DeliveryStore
Set acFolder = Store.GetDefaultFolder(olFolderSentMail)
Exit For
End If
Next
Set myOlItems = acFolder.Items
Else
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items
End If
End Sub
'Catch the added mail and save to folder
Private Sub myOlItems_ItemAdd(ByVal ObjectSent As Object)
'Code to do something with this mail. In my case: store to defined folder.
End Sub
If the account was explicitly set and the message has not been saved first, you might get null (aka Nothing in VB). In that case, assume the very first account from the Application.Session.Accounts collection will be used.
I have a custom outlook appointment, from which I want to automatically BCC a mail upon sending my a appointment invitation.
Function Item_Send()
Set oMsg = Application.ActiveInspector.CurrentItem
With oMsg
Set objRecip = Item.Recipients.Add("MyEmail#mail.com")
objRecip.Type = olBCC
objRecip.Resolve
End With
Set oMsg = Nothing
End Function
Everything seems to work fine - My email is attached as BCC, and the appointment is successfully being send.
However, in my inbox I'm getting a mail, that the BCC mail could not be reached.
Your message did not reach some or all of the intended recipients.
Subject:
Sent: 18/06/2020 14:49
The following recipient(s) cannot be reached:
MyEmail on 18/06/2020 14:49
'MyEmail#mail.com' on 18/06/2020 14:49
This message could not be sent. Try sending the message again later, or contact your network administrator.
Diagnostic information for administrators:
Error is [0x80070057-0x00000000-0x00000000]. Submit-Message failed:
message id(23), failure enum(7), HResult(0x80070057), EC(-2147024809).
Why is this error occuring? My mail is not incorrect.
It is not clear where the Item object comes from.
First of all, the Type property for MeetingItem recipients can be one of the following OlMeetingRecipientType constants: olOptional, olOrganizer, olRequired, or olResource. If you want to send a BCC I'd recommend creating a new mail item and copy properties to the new item.
Anyway, the Resolve method returns a boolean value which is true if the object was resolved; otherwise, false. For example, that is how you need to check this out:
Sub AssignTask()
Dim myItem As Outlook.TaskItem
Dim myDelegate As Outlook.Recipient
Set MyItem = Application.CreateItem(olTaskItem)
MyItem.Assign
Set myDelegate = MyItem.Recipients.Add("Eugene Astafiev")
myDelegate.Resolve
If myDelegate.Resolved Then
myItem.Subject = "Prepare Agenda For Meeting"
myItem.DueDate = Now + 30
myItem.Display
myItem.Send
End If
End Sub
Be aware, the ItemSend event handler accepts two parameters. For example, the following code in VB.NET works like a charm on my machine:
Imports System.Runtime.InteropServices
' ...
Private Sub OnItemSend(Item As System.Object, ByRef Cancel As Boolean) _
Handles Application.ItemSend
Dim recipient As Outlook.Recipient = Nothing
Dim recipients As Outlook.Recipients = Nothing
Dim mail As Outlook.MailItem = TryCast(Item, Outlook.MailItem)
If Not IsNothing(mail) Then
Dim addToSubject As String = " !IMPORTANT"
Dim addToBody As String = "Sent from my Outlook 2010"
If Not mail.Subject.Contains(addToSubject) Then
mail.Subject += addToSubject
End If
If Not mail.Body.EndsWith(addToBody) Then
mail.Body += addToBody
End If
recipients = mail.Recipients
recipient = recipients.Add("Eugene Astafiev")
recipient.Type = Outlook.OlMailRecipientType.olBCC
recipient.Resolve()
If Not IsNothing(recipient) Then Marshal.ReleaseComObject(recipient)
If Not IsNothing(recipients) Then Marshal.ReleaseComObject(recipients)
End If
End Sub
This event triggers right after the user clicks the Send button in Outlook (before the inspector window is closed) or when the Send method of Outlook items is called. The ItemSend event provides two parameters to the programmer:
The Item object – an Outlook item that is going to be sent. It can be represented by the AppointmentItem, MailItem, MeetingItem, MobileItem, SharingItem, TaskItem classes.
The Cancel parameter – allows you to cancel sending in Outlook. The default value is false. If you set the Cancel parameter to true in the event handler, the sending process is canceled and the inspector window is shown to the user.
Read more about that in the How To: Change an Outlook e-mail message before sending using C# or VB.NET article.
i have created a outlook macro where if i want to send email other then the listed email id,it will give me a popup. However, i am not being able to add multiple email ids to the list. please find the below code that i have written. Can someone please help me how to add multiple email ids in my below code?
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Const ADDR_TO_WATCH_FOR = "James.t#outlook.com"
Dim olkRec As Outlook.Recipient
If Item.Class = olMail Then
For Each olkRec In Item.Recipients
If LCase(olkRec.Address) <> ADDR_TO_WATCH_FOR Then
If MsgBox("This message is addressed to " & ADDR_TO_WATCH_FOR & ". Are you sure you want to send it?", vbQuestion + vbYesNo, "Confirm Send") = vbNo Then
Cancel = True
End If
Exit For
End If
Next
End If
Set olkRec = Nothing
End Sub
Don't show the message box inside the loop over all recipients. Run the loop first and check all recipients. Build a list of multiple recipients if necessary. After you exit the loop, check if that list (a string) if not empty, show the message box.
EDIT: New info: I just now realised that, while the return of Mailitem.Body is "", the actual value is "Application-defined or object-defined error" . I'm not entirely sure what that means, but I do know it shows up in multiple fields-- I included a screen shot below.
I am having an issue where certain properties will return the correct value, and others will not. I have an example email, where I have an email with subject "Subject", the message is "Body", the sender email address is "email#address.com", and the date sent is 12 June 2013.
When I run the following code:
Dim ComputerName As String
Dim ErrorState As String
For Each MailItem In InboxItems
ComputerName = MailItem.Subject
'ErrorState = MailItem.Body
ErrorState = MailBody(MailItem)
strDate = GetDate(MailItem.SentOn)
SenderEmail = MailItem.SenderEmailAddress
If strDate = DateToday And SenderEmail = "email#address.com" Then
Computers(a, 0) = ComputerName
Computers(a, 1) = ErrorState
a = a + 1
End If
Debug.Print MailItem.Subject
Debug.Print MailItem.Body
Next MailItem
What I get is ComputerName = "Subject", ErrorState = "", SenderEmail = "", and strDate = "2013/6/12" (which is the proper format in this case). Why would this return proper values for two of the Mailitem properties, but not for two of the others? This is a very strange problem, and I would appreciate any help you all might be able to give!
I will add more of the context for the code here:
Set objOutlook = CreateObject("Outlook.Application", "localhost")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set Inbox = GetFolder("email#address.org/inbox")
Set InboxItems = Inbox.Items
InboxItems.SetColumns ("SentOn")
GetFolder is a function to get the mailbox by folder path. I have to do this because I am not using the default inbox in outlook.
I also tried using the MailBody Function proposed below, in case the body were in an HTML or RTF format. Unfortunately, it proved that the body was normal, and MailItem.Body should have retrieved it, and it still is not working. MailItem.Body returns "", even though I know that the email has a body. The body is just the number 1, and that is what I should be getting.
Also, I should note that the sender of the email is the same as the recipient; in other words, the email was sent from one email address to itself. I don't know if this could make a difference, but I figured that I would put it out there just in case.
Multiple Item Types
First, there is no guarantee that all items in the Inbox.Items collection are of type MailItem. Inboxes also contain AppointmentItem, MeetingItem, and other *Item type objects. Not all of these item types have the same properties populated. To ensure you do not get a type mismatch error, declare your iterator variable as a generic Object and only assign it to a strongly-typed MailItem variable if it is of the correct type:
Dim oInbox As Outlook.Folder
Dim oItem As Object
Dim oMailItem As MailItem
Set oInbox = ActiveExplorer.Session.DefaultStore.GetRootFolder().Folders("Inbox")
For Each oItem In oInbox.Items
If TypeOf oItem Is MailItem Then
Set oMailItem = oItem
' Do stuff
Else
Debug.Print "Skipping " & TypeName(oItem)
End If
Next
Optional properties
Second, there is no gaurantee that all properties of an object will be populated. If a mail item was never sent, it will have no sender address, and certainly it is possible to have an email with no body. A good way to get familiar with which properties are available and what they contain is to use the Locals window (View > Locals Window in the VBA IDE). Here's a screen shot of the above code paused in the loop, with some of the properties of the oMailItem object expanded:
Body vs. HTMLBody
MailItem objects have three body properties: Body, HTMLBody, and RTFBody. Usually only one of them is populated. Which one depends on the format of the email. You can check the BodyFormat property to find which one is applicable to the current item. Using that, here's a generalized way to get the raw body of a MailItem, no matter what the format:
Public Function MailBody(ByVal MailItem As MailItem) As String
Select Case MailItem.BodyFormat
Case OlBodyFormat.olFormatPlain, OlBodyFormat.olFormatUnspecified
MailBody = MailItem.Body
Case OlBodyFormat.olFormatHTML
MailBody = MailItem.HTMLBody
Case OlBodyFormat.olFormatRichText
MailBody = MailItem.RTFBody
End Select
End Function