How to add multiple safe addresses in outlook - vba

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.

Related

Searching Message For Key Words In Outlook

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.

How do I remove text in the body of an email before send?

Our company puts a notice on any incoming email from an outside source to warn us to exercise caution when opening attachments or clicking on links. Warranted? Yes. Annoying? Yes. Looks somewhat unprofessional? Maybe.
I've tried several different iterations of VBA to ask if I want the message removed on send. My current code is below and it will bring up the message box, so I know that my formatting is correct and it finds the text, but it won't actually remove it.
Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strBody As String
If InStr(Item.Body, "NOTICE: This email is from an external sender. Please exercise caution when opening attachments or clicking links.") > 0 Then
If MsgBox("Do you want to remove the Notice?", vbYesNo) = vbYes Then
strBody = Replace(Item.Body, "NOTICE: This email is from an external sender. Please exercise caution when opening attachments or clicking links.", "", vbTextCompare)
Else
strBody = Item.Body
End If
End If
Item.Save
End Sub
I would like for the message box to come up and ask if the notice needs to be removed and then remove it if I click yes, but leave everything else in the email alone. One caveat is that there could be multiple instances of this notice if it's a long chain with multiple replies. If I'm the only one on the chain then my macro will have removed any in prior replies, but if others are on the chain and don't remove theirs then I'd like my macro to do it if I reply (I realize I can't do anything about others).
Would the code need to be any different if it's an HTML email versus plain text?
EDIT: Here's my current code. I've got it to remove the notice and it now will not delete a new email, but the send on a reply is really slow.
Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strBody As String
If InStr(Item.HTMLBody, "LHMSE NOTICE: This email is from an external sender. Please exercise caution when opening attachments or clicking links.") > 0 Then
If MsgBox("Do you want to remove the LHMSE Notice?", vbYesNo) = vbYes Then
strBody = Replace(Item.HTMLBody, "LHMSE NOTICE: This email is from an external sender. Please exercise caution when opening attachments or clicking links.", "", vbTextCompare)
Item.HTMLBody = strBody
Else
strBody = Item.HTMLBody
End If
End If
Item.Save
End Sub
You never set the Item.Body property back with the new value stored in the strBody variable. Also keep in mind that you will wipe out the formatting since you are dealing with the plain text body rather than MailItem.HTMLBody.

Detect whether an email is currently being edited in Outlook?

I have a macro that runs on the Application_NewMail event - but I've seen it have weird impacts if the user is currently composing an email or reply - sometimes crashing outlook and losing their progress.
Is there a way that I can detect whether the user is currently composing an email?
This would allow me to cancel the macro and avoid interrupting the user.
I was able to find bits and pieces from related questions, but nothing that took into account both the pop-up email editor and the inline-response. Here's the solution I pulled together (which seems to cover all bases):
Private Function IsUserEditing() As Boolean
' Check if the user is composing an email. Don't interrupt them if we are.
' 1. Check if the user has the pop-up email 'inspector' window open
If Not (Application.ActiveInspector Is Nothing) Then
Dim OpenWindow As Variant
Set OpenWindow = Application.ActiveInspector.CurrentItem
If TypeOf OpenWindow Is MailItem Then
Dim NewMail As MailItem
Set NewMail = OpenWindow
' Check if the mail they're viewing is not 'Sent' (i.e. being edited)
If Not (NewMail.Sent) Then
IsUserEditing = True
Exit Function
End If
End If
' 2. Check if the user is replying to an email using the 'inline response' feature
ElseIf Not (Application.ActiveExplorer.ActiveInlineResponse Is Nothing) Then
IsUserEditing = True
Exit Function
End If
IsUserEditing = False
End Function
It can be used like this:
Private Sub Application_NewMail()
Debug.Print "New mail received..."
' Check if the user is composing an email. Don't interrupt them if we are.
If IsUserEditing Then
Debug.Print "User appears to be composing an email. Cancelling..."
Exit Sub
End If
' Otherwise Proceed
PerformOnNewMailActions
End Sub
Hope this helps others!

React upon entering a keyword in the message body of Create New Mail window

I want, when I compose a new email, if I enter a certain keyword (e.g "#servicedesk"), there would be a pop-up that would ask me to cc the email to a specific address (servicedesk#123corp.com).
If you use a unique keyword, a non-VBA solution is simpler.
Create a rule.
Apply rule on messages I send.
with specific words in the body
Cc the message to people or public group
If the keyword is not unique then:
Application_Itemsend example http://www.slipstick.com/outlook/email/macro-to-warn-before-sending-a-message-with-a-blank-subject/
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strSubject As String
strSubject = Item.Subject
If Len(Trim(strSubject)) = 0 Then
Prompt$ = "Subject is Empty. Are you sure you want to send the Mail?"
If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for Subject") = vbNo Then
Cancel = True
End If
End If
End Sub
Use InStr to parse Item.Body. http://www.slipstick.com/developer/parsing-text-fields-in-outlook/
Then MsgBox to confirm Item.cc = "servicedesk#123corp.com"

Outlook - insert text based on recipient

I need to automatically insert text into an outgoing email depending on the recipient. I found some code in an answer to another question (credit to 76Mel) that looks promising. It seems that I could attach the code to ItemSend in ThisOutlookSession
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If Item.MessageClass = "IPM.Note" Then
For Each myRecipient In Item.Recipients
If myRecipient.Address = "<EMAIL ADDRESS TO FIND>" Then
<code to add text>
End If
Next
End If
End Sub
What would the code be that adds the text to the body of the email - and would this even work? Would this code fire before the email is sent, or is it already too late?
I do need it to be automated (creating a button or running the macro manually isn't really an option; it's a memory thing: if I could remember to run the macro, I could just add the text manually)
Is this what you are trying? I have added the comments so you shouldn't have any problem understanding it :) If you still have a question, simply ask...
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'~~> Check if it is an email
If TypeName(Item) <> "MailItem" Then Exit Sub
Dim srchString As String, NewText As String
'~~> Email Address which you want to search for
srchString = "abc#gmail.com"
'~~> New text that you want to add
NewText = "Blah Blah"
'~~> Search To, CC, BCC Fields
If InStr(1, Item.To, srchString, vbTextCompare) Or _
InStr(1, Item.CC, srchString, vbTextCompare) Or _
InStr(1, Item.BCC, srchString, vbTextCompare) Then
'~~> Add the relevant text to the body
Item.Body = Item.Body & vbNewLine & NewText
End If
End Sub
I would recommend this MSDN Link.
Topic: MailItem Object Members
Link: http://msdn.microsoft.com/en-us/library/bb176688%28v=office.12%29.aspx
Quote From the Above Link
Represents a mail message in an Inbox folder.
Lists all Methods / Properties for a MailItem Object