Outlook - check email address type - vba

I am trying to make a macro in Outlook that will scan the To: list for a certain text string, and spit out a message if all but one (or two, etc) addresses have it. Is there a simple way to do this?
Essentially, I am trying to write something that'll avoid being able to send a restricted message to a bunch of people with the string 'xyz' in the address, if one or more do not have it. AutoComplete makes this difficult, without checking through one-by-one.

This is possible using Outlook VBA.
You'd have to write an event hook for when the user sends an email. This is done using the Application_ItemSend(ByVal Item As Object, Cancel As Boolean) where Item is the item being sent (email or appointment), and cancel is a boolean you can set to stop the email from being sent.
In your code you would want to look at the recipients collection on the Item object to see who is going to be receiving the email.
For example:
Dim CurrRecip As Recipient
For Each CurrRecip in Item.Recipients
If InStr(1, CurrRecip.Address , "your search text here" , vbCompareText ) Then
debug.print "Message here..."
End If
Next CurrRecip
Hopefully that helps...

Related

Change response to Outlook meeting and add text

I would like to change the response to a meeting, that I have accepted, to tentative and send text like "I'm sorry, but I cannot attend.".
Online, I found solutions that show how to accept, cancel, forward, and copy a meeting.
I also understood that I can open the message to edit before sending the reply with
Item.Respond(olMeetingTentative, False, False)
I would like to have it automated.
I tried the following
Sub tentativeOccurenceWithResponse()
Dim Item As Outlook.AppointmentItem
Dim response As Outlook.MeetingItem
For i = ActiveExplorer.Selection.Count To 1 Step -1
Set Item = ActiveExplorer.Selection.Item(i)
If TypeName(Item) = "AppointmentItem" Then
If Item.ResponseRequested Then
Set response = Item.Respond(olMeetingTentative, True)
response.RTFBody = "Thank you for the invitation. Unfortunatelly, I cannot attend the meeting.\nPlease check my calendar for alternative time slots if my attendance is required."
response.Send
Else
Item.MeetingStatus = olMeetingTentative
End If
Set Item = Nothing
Else
MsgBox "Sorry, you need to select an appointment"
End If
Next
End Sub
The workflow:
I would like to go to my calendar and select meetings that I will not be able to join. Most of them are meeting serious or long time planned. Hence, it was not possible to react when I got the invitation.
I want to notify all Meeting organizers that I cannot attend, but I would like to get updates and might still be able to join in case of vacation changes. (So no decline here.)
First of all, you need to declare the item as a generic object because Outlook folders may contain different kind of items:
Dim Item As Object
Then in the loop you can check out the message class and only after making sure the item is an appointment you can cast it to the required type and process the item further.
For i = ActiveExplorer.Selection.Count To 1 Step -1
Set Item = ActiveExplorer.Selection.Item(i)
If TypeName(Item) = "AppointmentItem" Then
If you need to handle incoming items automatically you can handle the NewMailEx event of the Application class which is fired when a new message arrives in the Inbox and before client rule processing occurs. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example, MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item. So, you are interested in processing meeting items only. To recognize the item you need to get an instance of the incoming Outlook item. Use the Entry ID returned in the EntryIDCollection string to call the NameSpace.GetItemFromID method and process the item.
Also you may consider hooking up the ItemAdd event on the folder. The event is fired when one or more items are added to the specified collection. Note, this event does not run when a large number of items are added to the folder at once.

Outlook get warned before deleting messages from Outlook's explorer pane

This post first part is an answer to a question I couldn't find an answer to, while the second part is a remaining question on the topic.
Basically I tend to accidentally delete Outlook mails, sometimes even without noticing and therefore wanted a confirmation.
There is a solution for this when deleting an email opened in a separate window:
https://www.datanumen.com/blogs/get-warned-moving-deleting-items-outlook/ (Many thanks to that author btw)
but this solution does not cover the case of deleting an email from within Outlook's explorer pane.
This post gave a hint but not an answer
https://www.datanumen.com/blogs/get-warned-moving-non-empty-folder-outlook/
So the solution is (much of the code taken from the posts referenced above):
Private WithEvents objExplorer As Outlook.Explorer
Private WithEvents objCurrentFolder As Outlook.Folder
Private Sub Application_Startup()
Set objExplorer = Outlook.Application.ActiveExplorer
End Sub
Private Sub objExplorer_Activate()
'Get the currently selected folder
Set objCurrentFolder = objExplorer.CurrentFolder
End Sub
Private Sub objCurrentFolder_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)
Dim xPrompt As String
Dim xYesOrNo As Integer
xPrompt = "Delete?"
xYesOrNo = MsgBox(xPrompt, vbYesNo + vbDefaultButton2, "Confirm Deleting Mail")
If xYesOrNo = vbYes Then
Cancel = False
Else
Cancel = True
End If
End Sub
Remaining question
The annoying thing with the above code is that when deleting a selection of multiple emails, the confirmation request is issued for each email, which is quite a drag when deleting 10+ emails.
So far I've failed to come up with a proper, i.e. robustly coded solution for this (tried the selection approach – see the update below).
β†’ Any ideas?
Update 2020-June-08 – Quasi solution
By now I've got what I'd call a quasi solution covering all tricky cases encountered so far including events caused by undo, moving emails, opening an email in a separate window and then deleting, …
The trouble is that I now have got one flag (true/false) like variable and a counter which have to be updated each time one of the above events is fired. Result: Difficult to overview spaghetti like code πŸ™
β†’ I can post the code in case someone's interested, but be aware that it is not nice and short.
So your question is how to avoid multiple prompts? Off the top of my head:
1. On the first prompt, check the number of selected items (Application.ActiveExplorer.Selection.Count), store in a separate variable and skip that many future prompts by decrementing the counter each time the event handler fires and prompting only when it reaches 0).
2. Check the time when the prompt was displayed, and avoid showing future prompts for another, say, 3 seconds.

Automatically Remove Border Around Warning in Email Body

I just suffered the same problem as described in the discussion linked to below, but with a catch: My organization has added border and highlighting to the warning banner added on all external emails.
Referenced discussion:
Automatically Remove Warning in Email Body
I have developed code to strip the text out, which had to be split because the HTML source code uses different formatting for parts of the warning banner:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Item.HTMLBody = Replace(Item.HTMLBody, "Attention:", "")
Item.HTMLBody = Replace(Item.HTMLBody, "This email originated from outside the university.", "")
End Sub
This leaves behind an empty banner with a brown border and tan highlighting. All of this is prepended to the message in HTML code, but I don't know how to get VBA to search at the HTML level. I would like to modify the above to instead strip the following HTML from the message body:
<div style=3D"border:solid #9C6500 1.0pt;padding:2.0pt 2.0pt 2.0pt 2.0pt">
<p class=3D"MsoNormal" style=3D"line-height:11.0pt;background:#FFEB9C"><b><=
span style=3D"font-size:9.0pt;color:#9C6500">Attention:</span></b><span sty=
le=3D"font-size:9.0pt;color:black"> This email originated from outside the =
university.<o:p></o:p></span></p>
Can VBA edit at the HTML level, i.e., modify the source? The first line of the HTML code is what needs to go, but I am struggling to find the right command.
You need to remove the entire block containing this message.
<div> and </div> are like brackets around some Html that specify that everything between <div> and </div> is to be treated as a block. The author of the Html might what to create a block for any of several reasons. Here the author wants to specify the appearance of the block. So <div style=xxxx>yyyy</div> says apply style xxxx to yyyy.
Your question omits the trailing </div>. If this block appears at the very end of the message, the person who coded this addition might have omitted the </div although this is not good practice. More likely, you did not realise that the trailing <\div> was important.
My approach would be:
Use InStr to search for β€œThis message originated …”
Use InStrRev to search backwards for the <div
Use InStr to search for the </div>
Delete everything between the div and the <\div>
If you need the code to do this, I will send myself an email with this block so I can test the code. I do not like posting untested code.
Edit
I have written and partially tested code for the approach I would favour. I have not fully tested my code because I do not understand your approach.
As I understand it, your university adds a warning to emails received from outside the university. This happens before the email is released to you. I would expect you to use the Item Add event but you are using the Item Send event. I do not understand how this would give you the effect you seek.
I created an email containing a warning message using a gmail account and sent it to my Outlook account. The appearance of that email is:
This is not the same as your warning message, but it is close enough for testing.
I have a diagnostic routine that will output selected properties of selected emails to the Immediate Window or β€œall” properties of selected emails to a file. The output for the relevant part of the Html body is:
<di|
|v style='mso-element:para-border-div;border:solid windowtext 1.0pt;padding:1.0pt 4.0pt 1.0pt 4.0pt'>|
|<p class=MsoNormal align=center style='text-align:center;border:none;padding:0cm'><span style='font-|
|family:"inherit",serif;color:#303336;border:none windowtext 1.0pt;padding:0cm;background:aqua;mso-hi|
|ghlight:aqua;mso-fareast-language:EN-GB'>This email originated from outside the university.</span><o|
|:p></o:p></p></div>
I have deleted everything from the output except the DIV block containing the warning. If you would like more information about my diagnostic routine, I am happy to supply it.
The code to update the Html body is:
Sub RemoveWarning(ByRef ItemCrnt As MailItem)
Dim LcHtmlBody As String
Dim PosDivEnd As Long
Dim PosDivStart As Long
Dim PosMessage As Long
With ItemCrnt
' Check message contains warning
PosMessage = InStr(1, .HtmlBody, "This email originated from outside the university.")
If PosMessage = 0 Then
' No message found
Exit Sub
End If
' Find start and end div
LcHtmlBody = .HtmlBody ' Allow for "<DIV" and "<div"
PosDivStart = InStrRev(LcHtmlBody, "<div", PosMessage)
PosDivEnd = InStr(PosMessage, LcHtmlBody, "</div>")
If PosDivStart = 0 Or PosDivEnd = 0 Then
' Start div or end div or both not found
Exit Sub
End If
' Delete Div block from Html
.HtmlBody = Mid$(.HtmlBody, 1, PosDivStart - 1) & Mid$(.HtmlBody, PosDivEnd + 6)
End With
End Sub
The result of running this code is:
This has removed the entire warning, including the coloured box, but has left a gap. This code may not leave a gap with your warning message. If it does leave a gap with your message, you will probably need to delete an empty paragraph as well as the Div block. I would need to see the Html before your β€œ<div” or after your β€œ</div” before I could recommend how to expand my code.

MS Access 2019: How do I check for duplicate records before update, then run a specific procedure if duplicates are found?

I am very new to both StackOverflow and to doing any sort of advanced programming in MS Access. I created a database to catalog my trading card collection (Excel just wasn't cutting it since we're talking about over 2000 unique cards). At first it was just a simple table of records, but now it's turned into a full-fledged database that I have search forms for and queries and everything.
What I'm trying to do right now is streamline my process a bit, and there is something very specific that I want to make Access do. I'm almost certain that whatever I want to do will have to be done in VBA, and I'm just not familiar enough with it to do what I want.
What I want it to do is this: Any time a new record is entered, I want it to check the record before it saves the record into the DB (I'm fairly confident that I need to use the "Before Update" event for this) and make sure that the "Sort ID" field (an auto-calculated field I've created) contains no duplicates (I know I'll most likely have to use queries for this since auto-calculated fields can't be indexed). If the program detects a duplicate, I want it to produce a message box saying that I'm trying to enter a duplicate record and ask me if I want to update the "number owned" field of the existing record instead of creating a new one, and then take me to the record in question on an affirmative response.
What I currently have is a validation rule that uses an index (comprised of the fields that generate the Sort ID), which generates a custom error message by using the following VBA code in the "On Error" event:
Private Sub Form_Error(DataErr As Integer, Response As Integer)
Const conErrRequiredData = 3022
If DataErr = conErrRequiredData Then
MsgBox ("Duplicate Sort ID. Please update the 'number owned' field on the existing record instead.")
Response = acDataErrContinue
Else
Response = acDataErrDisplay
End If
End Sub
This code works exactly as it should, but I want more than a pop-up error that I can't do anything with. I have a query entitled "CheckDuplicateSortID" that I created using the Query Wizard, and it checks the "Sort ID" field for duplicates, but that's as far as I've managed to get. The example on This site is about the closest I've managed to find to what I'm looking for, but the code sample given is very difficult for me to understand because there's very little explanation with it; I'm not familiar enough with Access VBA to know which parts are important code and which parts are his specific field names and other variables; I haven't gotten any error messages because I'm stumped on even trying to figure out what needs to be changed from that sample code and what it needs to be changed to.
Edit: Just for the sake of clarification, the solution doesn't have to involve the Sort ID field. I created that so I'd have one field I can point the program to. But if it would be simpler to just use the index that I use for my current validation rules (with the error message generated by the above code), I'm open to that too.
After some considerable finagling, I actually managed to find a solution to this on my own, though it is probably needlessly complicated (I'm definitely open to simpler solutions, if anyone has any).
Rather than using the actual SortID field, I modified the code in the OP to this:
Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim strMsg As String
Dim iResponse As Integer
'The text to be displayed in the message prompt.
strMsg = "Unable to save record. The values you have entered would generate a duplicate." & Chr(10)
strMsg = strMsg & "Would you like to clear this form and edit the existing record instead?"
'Calls for the yes/no message prompt specifically when the no-duplicate
'validation rule is violated (error 3022).
Const conErrRequiredData = 3022
If DataErr = conErrRequiredData Then
iResponse = MsgBox(strMsg, vbQuestion + vbYesNo, "Invalid Sort ID")
Response = iResponse
If iResponse = vbYes Then
'Calls a custom function that opens the record in question for editing.
UpdateOnError
Else
'Cancels the operation on a negative response and does not clear the form.
Cancel = True
End If
Else
Response = acDataErrDisplay
End If
End Sub
As you can see from the above code, the event calls a custom function, which is coded as follows:
Function UpdateOnError()
On Error GoTo UpdateOnError_Err
Dim UpdateGoToID As Variant
'Selects the Sort ID in question for the purpose of opening the existing record.
UpdateGoToID = Forms![Card List Entry Form]!txtSortID
'Clears the invalid form.
DoCmd.RunCommand acCmdUndo
'Opens the existing record the user attempted to duplicate.
DoCmd.OpenForm "Card List Entry Form", acNormal, "", "[Sort ID]=" & "'" & UpdateGoToID & "'", , acNormal
UpdateOnError_Exit:
Exit Function
UpdateOnError_Err:
MsgBox Error$
Resume UpdateOnError_Exit
End Function
Like I said, this is probably a lot more steps than actually needed, but it does work as I want it to: when the user attempts to enter a duplicate record, an error message pops up asking if they would like to update the existing record. If yes, it takes them to the existing record. If no, it closes the error message without clearing the form or saving the record.

Setting Default Signature selection in Outlook

I can't find an answer to this on the forum, or maybe i'm not typing my query in accurately enough.
With my Outlook 2010 at my workplace the default Signature block keeps getting changed to a default option when I load up Outlook. I don't have access to the source file to make any changes as it is all Server side.
What I want to do is change the default selection of my Signature from the old one to a new one.
Under File -> Options -> Mail -> Signatures I want to change my default Signature to something else upon start up of Outlook 2010 using a VBA code of some form. Is there any way that this can be done?
I have already created the new Signature but I need to reselect it as the default option every time I log onto my terminal, which is frustrating.
Looking for any help please.
After some cursory searching, it looks like Outlook signatures are managed through the Windows registry (for example, see here and here). Specific registry paths seem to depend on your version of Outlook.
Of course, if it's your work email, it's likely you can't make any changes to your registry.
However, if all you want is to automatically insert some specific text to any new email, that can be done via VBA. Basically, you want to use the Open event of a new email to insert specific text. To do that, you need to add the Open hook during the ItemLoad event. Something like this:
' declare the mail item that will have the Open event available
Public WithEvents myItem As Outlook.mailItem
' defines how the Open event will be handled
' note that you only want to do this with unsent items
' (hence the .Sent check)
Private Sub myItem_Open(cancel As Boolean)
If Not myItem.Sent Then
'insert your signature text here
End If
End Sub
' hooks the Open event to a mail item using the ItemLoad event
Private Sub Application_ItemLoad(ByVal Item As Object)
Dim mailItem As Outlook.mailItem
If Item.Class = OlObjectClass.olMail Then
Set myItem = Item
End If
End Sub
For more information, see the relevant Microsoft articles on the Application.ItemLoad event and MailItem.Open event.