I have a VBA macro for Outlook 2016 that enables or disables an email rule when a named appointment reminder fires.
The auto-enable and auto-disable parts are working, but I want to auto-dismiss the reminder afterwards.
I get
Runtime error '-2147024809 (80070057)'
with olRemind(i).Dismiss highlighted.
I am pretty sure it is throwing an error because the reminder hasn't shown up in the list of reminders yet. However, when I check ?olRemind(i) in the Immediate window it does return the correct caption (Enable TEST). It seems like the reminder both does and does not exist?
When I halt code execution, the reminder pops up and the email rule is auto-enabled (or disabled), so I know the rest of the code is working.
My hypothesis is that I need to refresh either the list of Reminder objects or the application itself (something similar to Excel's Application.ScreenUpdating). I called DoEvents to try and accomplish this but it didn’t fix the problem. I couldn't find another method or property that does this in Outlook.
Public WithEvents olRemind As Outlook.Reminders
Private Sub Application_Reminder(ByVal Item As Object)
Set olRemind = Outlook.Reminders
Dim i As Integer
If Item.MessageClass <> "IPM.Appointment" Then
Exit Sub
End If
If Item.Subject = "Enable TEST" Then
Call OnOffRunRule("TEST", True, False)
DoEvents
'Wait 5 seconds
Wait (5)
'Dismiss reminder
For i = olRemind.Count To 1 Step -1
If olRemind(i).Caption = "Enable TEST" Then
'***THE FOLLOWING LINE CAUSES A RUNTIME ERROR***
olRemind(i).Dismiss
End If
Next
End If
If Item.Subject = "Disable TEST" Then
Call OnOffRunRule("TEST", False, False)
DoEvents
'Wait 5 seconds
Wait (5)
'Dismiss reminder
'***THE FOLLOWING LINE CAUSES A RUNTIME ERROR***
Application.Reminders("Disable TEST").Dismiss
End If
End Sub 'Application_Reminder
'Enable or disable a rule
Sub OnOffRunRule(RuleName As String, Enable As Boolean, Optional blnExecute As Boolean = True)
Dim olRules As Outlook.Rules
Dim olRule As Outlook.Rule
Dim intCount As Integer
Set olRules = Application.Session.DefaultStore.GetRules
Set olRule = olRules.Item(RuleName)
If Enable Then olRule.Enabled = True Else olRule.Enabled = False
If blnExecute Then olRule.Execute ShowProgress:=True
olRules.Save
Set olRules = Nothing
Set olRule = Nothing
End Sub 'OnOffRunRule
I tried two different methods for dismissing the reminder (see the two comments under "Enable TEST" vs. "Disable TEST"). Both triggered the same runtime error.
Ignore the Wait (5) call, that just loops DoEvents until 5 seconds from the current time.
The error is MAPI_E_INVALID_PARAMETER. Try to set Item.ReminderSet = false instead of calling Reminder.Dismiss.
You will probably be better off using Reminders.BeforeReminderShow event (where Reminders comes from Application.Reminders) - you can set the Cancel parameter passed to your event handler to true.
Related
I've created a Macro based on a blog post that only successfully runs in the VBA editor. When I run it from Outlook itself, nothing happens. Maybe you can see something obvious that I'm missing.
Pressed Alt+F11 to open the editor.
Named the module and pasted in the code.
Compiled and run. The e-mail in question opened in HTML-format as expected.
Closed the editor and added the button to the toolbar I wanted. Nothing happens.
Returned to the VBA editor and run the code. It works as expected.
Closed and re-opened Outlook to try the button again. Nothing happens.
Here's the code, with a screenshot of the code in the editor to follow.
Sub ReplyInHtmlFormat()
Dim olSel As Selection
Dim oMail As MailItem
Dim oReply As MailItem
Set olSel = Application.ActiveExplorer.Selection
Set oMail = olSel.Item(1)
If oMail.BodyFormat = olFormatPlain Or olFormatRichText Or olFormatUnspecified Then
oMail.BodyFormat = olFormatHTML
oMail.Save
End If
Set oReply = oMail.Reply
oReply.Display
Set olSel = Nothing
Set oMail = Nothing
Set oReply = Nothing
End Sub
You may want to check the macro permissions to make sure it is allowed to run. I hope that helps! ;-)
Try to add MsgBox statement outside of any If statement and you will be able to understand whether it is actually running or not when you click a button added to the toolbar.
Also, I'd recommend adding an error-handling routine to the function:
Public Sub OnErrorDemo()
On Error GoTo ErrorHandler ' Enable error-handling routine.
Dim x, y, z As Integer
x = 50
y = 0
z = x / y ' Divide by ZERO Error Raises
ErrorHandler: ' Error-handling routine.
Select Case Err.Number ' Evaluate error number.
Case 10 ' Divide by zero error
MsgBox ("You attempted to divide by zero!")
Case Else
MsgBox "UNKNOWN ERROR - Error# " & Err.Number & " : " & Err.Description
End Select
Resume Next
End Sub
So, you will be aware of any issues if any.
When you preview a report, right-click offers the option, Send to... -> Mail Recipient.
I need to catch this event and execute code the reads the recipient e-mail address as typed into Outlook when it appears. This code should be in a module in the Access database.
If possible, I would also like to read the Subject.
It's hard to find answers on the Web, and despite some experience with Access and VBA, I don't know how to even start.
Edit: From Dmitry's answer I found this loop through Inspectors,
Private Sub Form_Timer()
Dim myInspectors As Outlook.Inspectors
Dim x As Integer
Dim iCount As Integer
Set myInspectors = Application.Inspectors
iCount = Application.Inspectors.Count
If iCount > 0 Then
For x = 1 To iCount
MsgBox myInspectors.Item(x).Caption
Next x
Else
MsgBox "No inspector windows are open."
End If
End Sub
but it gives this compile error:
Edit 2:
I have moved the code into a function, and when Outlook is running, I get no errors from this GetObject call. But with this function on a 2s timer, objApp.Inspectors.Count remains 0 while I compose an email and send it.
Public Function checkInspectors() As Boolean
Dim myInspectors As Outlook.Inspectors
Dim OutLookWasNotRunning As Boolean
Dim objApp As Object
Set objApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then OutLookWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.
If Not OutLookWasNotRunning Then
Set myInspectors = objApp.Inspectors
Dim x As Integer
Dim iCount As Integer
iCount = objApp.Inspectors.Count
If iCount > 0 Then
For x = 1 To iCount
Debug.Print myInspectors.Item(x).Caption
Next x
Debug.Print "---"
Else
'MsgBox "No inspector windows are open."
End If
End If
End Function
Normally, Application.Inspectors.NewInspector event would fire, but Outlook disables that event for the messages opened through Simple MAPI. Your best bet is to scan the Application.Inspectors collection periodically (timer?) to check if there is a new inspector open.
Once you have an Inspector object, you can check the Inspector.CurrentItem.Recipients collection.
Well, one of the possible solutions is to develop an Outlook add-in or VBA macro which may track outgoing emails. The ItemSend event of the Application class which is fired whenever a Microsoft Outlook item is sent, either by the user through an Inspector (before the inspector is closed, but after the user clicks the Send button) or when the Send method for an Outlook item, such as MailItem, is used in a program.
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!
Trying to run a rule to move emails upon arrival from first public email box to second public email box.
Rule is: Apply this rule after the message arrives | Sent to "first public email box" | move it to the "second public email box" folder.
Rule works when run manually but the rule does not work automatically upon emails arriving (research shows there might be some corrupt file, ...).
Trying to make it work via VBA instead. Below macro supposed to run the rules upon a reminder popping up. Reminder pops up, but rules don't run.
Running that macro from a QAT custom button, brings up progress window, and that window shows progress, but emails are still in the first public email box.
Private Sub Application_Reminder(ByVal Item As Object)
If Item.MessageClass <> "IPM.Task" Then
Exit Sub
End If
If Item.Subject = "Run Rules" Then
RunRules
End If
End Sub
Sub RunRules()
Dim olRules As Outlook.Rules
Dim myRule As Outlook.Rule
Dim olRuleNames() As Variant
Dim name As Variant
olRuleNames = Array("Rule A", "Rule B")
Set olRules = Application.Session.DefaultStore.GetRules()
For Each name In olRuleNames()
For Each myRule In olRules
' Rules we want to run
If myRule.name = name Then
myRule.Execute ShowProgress:=True
End If
Next
Next
End Sub
The use of DefaultStore is a hint there are stores other than the default.
Set olRules = Application.Session.DefaultStore.GetRules()
Option Explicit
Private Sub FindStoreWithRules()
Dim colStores As stores
Dim oStore As store
Dim olRules As rules
Dim myRule As Rule
Dim i As Long
Set colStores = Session.stores
For i = 1 To colStores.count
Debug.Print i & ": " & colStores(i)
' On second run
' Enter applicable name then uncomment this line and the End If
' If colStores(i) = "Name of store shown in immediate window" Then
On Error Resume Next
' Where rules not applicable on some stores there is an error.
Set olRules = colStores(i).GetRules()
' Discontinue error bypass as soon as the purpose is served
On Error GoTo 0
If Not olRules Is Nothing Then
For Each myRule In olRules
' Uncomment on second run to see if what rules were found
'Debug.Print " - " & myRule.name
Next
Else
Debug.Print "Rules not applicable in " & colStores(i)
End If
' End If
Next
Debug.Print "Done."
End Sub
I use a outlook rule to process incoming mail via a VBA macro.
in the vba various actions are triggerd to process attachments of the incoming mail.
The problem is, there somethimes is a stack of e-mails that need to be processed.
I cant seem to find a way how to trigger the one by one.
I want to wait a few seconds before processing the next mail, if there is a stack.
Putting a sleep method in the macro doesnt seem to have effect. the rule doesnt seem to wait for the previous message to be done.
My method i something like:
Is there a way to accomplish this behaviour?
Private Sub ProcessMail(ByVal Item As Object)
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
If TypeOf Item Is Outlook.MailItem Then
Dim Msg As Outlook.MailItem
DoProcessingMethod
End If
End If
End Sub
Putting a wait or sleep in the method doesnt cause it to be processed one by one.
GD Arnold,
You could indeed use the ItemAdd option as per #Brett's answer.
I use a similar process to automatically upload received data (as attachment in an email) and upload this to a MySQL database. The action is triggered by the ItemAdd method and mails are checked one-by-one.
Simplified instructions:
Add a Class to your VBA code named "EventClassModule"
In your class, type
Public WithEvents dItems As Outlook.Items
In your ThisOutlookSession make a sub that registers the event_handler:
Sub Register_Event_Handler()
Set myClass.dItems = Outlook.Items
End Sub
In your ThisOutlookSession make a sub that handles the ItemAdd event as below:
Private Sub dItems_ItemAdd(ByVal newItem As Object)
On Error GoTo ErrorHandler
Dim msg As Outlook.MailItem
If newItem.Class = olMail Then
Set msg = newItem
'Do something with the msg item, check rules, check subject, check whatever
'This will process messages when the arrive in your mailbox one by one.
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
These steps should provide you with a sub that is triggered when a new mail arrives.
You could then call a function/sub like below.
The below sub runs all rules based on an optional ruleSet variable, it checks the rule.Name against the ruleSet and if the ruleSet string exists in the rule.Name then it executes some code. This way you can have multiple rules and only execute some of them based on which 'ruleSet' they are part of. You can define that by altering their name.
It's a refinement of the 'Run Rules' option in Outlook.
Some of this code came frome here: Setting VBA to read personal inbox
Sub runRules(Optional ruleSet As String)
Dim olStore As Outlook.Store
Dim myRules As Outlook.Rules
Dim tmpInbox As Outlook.Folder
Dim tmpSent As Outlook.Folder
Dim rl As Outlook.Rule
'On Error Resume Next
'toTmpBox (ruleSet)
' get default store (where rules live)
Set olStore = Application.Session.DefaultStore
With olStore
Set tmpInbox = .GetDefaultFolder(olFolderInbox) '.Folders("tmpInbox")
Set tmpSent = .GetDefaultFolder(olFolderSentMail) '.Folders("tmpSentBox")
End With
' get rules
Set myRules = olStore.GetRules
' iterate through all the rules
For Each rl In myRules
Debug.Print rl.Conditions.Body.Enabled & " " & rl.Conditions.Body.Text
If InStr(LCase(rl.Name), ruleSet) > 0 And (rl.Enabled) Then
rl.Execute ShowProgress:=True, Folder:=tmpInbox
If ruleSet = "autorun" Then
rl.Execute ShowProgress:=True, Folder:=olStore.GetDefaultFolder(olFolderSentMail)
End If
ruleList = ruleList & vbCrLf & rl.Name
End If
Next
' tell the user what you did
ruleList = "These rules were executed " & _
vbCrLf & ruleList
MsgBox ruleList, vbInformation, "Macro: RunMyRules"
CleanUp:
Set olStore = Nothing
Set tmpInbox = Nothing
Set tmpSent = Nothing
Set rl = Nothing
Set myRules = Nothing
End Sub
I have come across a similar problem. In my case my tool would run at regular time interval and each time I had to capture new emails only. Now new emails could be one or multiple. the solution I found was as given below.
Each time the tool would run. it will capture the new emails and just mark a simple ',' or '|' anything of your choice at the end of the subject in such a way that no one will notice. Now next time when the tool runs it checks if the emails received for the entire day or two (based on your requirements) has those markers or not.
This solution works if the email communication is one way. If we use these email for chain emails then their is another solution.
Here you will have to save the time max time of emails captured in the last run. Now each time you run you just have to run it for the entire day and put an if statement that is should be greater then time last captured.
Now to store the max time you might need to create a folder and an email. The email can help you to store the each time the run happens
item.subject = maxtime
item.save