I want to accept or tentatively accept meeting requests in Outlook, depending on whether I have a meeting at that time. I've got the rule set up; it runs the VBA as far as I know, but the code isn't working. I can't find the issue with it.
Sub AcceptDecline(oRequest As MeetingItem)
If oRequest.MessageClass <> "IPM.Schedule.Meeting.Request" Then
Exit Sub 'if this messageclass isn't a meeting request
End If
Dim oAppt As AppointmentItem
Set oAppt = oRequest.GetAssociatedAppointment(True)
Dim myAcct As Outlook.Recipient
Dim myFB As String
Set myAcct = Session.CreateRecipient("roconnor#pattonair.com")
myFB = myAcct.FreeBusy(oAppt.Start, 5, False) 'gets the free or busy status of my calendar
Dim oResponse
Dim i As Long
Dim test As String
i = (TimeValue(oAppt.Start) * 288)
test = Mid(myFB, i - 2, (oAppt.Duration / 5) + 2)
If InStr(1, test, "1") Then
Set oResponse = oAppt.Respond(olMeetingTentative, True)
oResponse.Display
oResponse.Send
Else
Set oResponse = oAppt.Respond(olMeetingAccepted, True)
oResponse.Display
oResponse.Send
End If
End Sub
If the meeting request automatically creates a meeting that is tentatively accepted then free busy indicates you are busy. The response will always be tentative accept.
File-> Options-> Mail-> Tracking-> disable: Automatically process meeting requests and responses to meeting requests and polls
https://www.msoutlook.info/question/do-not-automatically-accept-meeting-as-tentative
If that is not the problem then open the request, which is not automatically marked tentative, and step through with:
Private Sub AcceptDecline_test()
AcceptDecline ActiveInspector.currentItem
End Sub
Related
I'm working on a simple Outlook VBA script to accept all selected meeting requests. Many online examples suggest something like the following code should work:
Sub AcceptItem()
Dim cAppt As AppointmentItem
Dim oRequest As MeetingItem
Dim x As Integer
For x = Application.ActiveWindow.Selection.Count To 1 Step -1
If (Application.ActiveWindow.Selection.Item(x).MessageClass = "IPM.Schedule.Meeting.Request") Then
Set cAppt = Application.ActiveWindow.Selection.Item(x).GetAssociatedAppointment(True)
Set oRequest = cAppt.Respond(olMeetingAccepted, True)
oRequest.Send
End If
Next x
End Sub
But the script always fails at oRequest.send -- when I inspect with the debugger, oRequest is always set to Nothing after the Respond line is executed, rather than containing a MeetingItem.
What am I doing wrong?
Before calling the Respond method in the code you need to check the AppointmentItem.ResponseRequested property which returns a boolean that indicates true if the sender would like a response to the meeting request for the appointment.
For x = Application.ActiveWindow.Selection.Count To 1 Step -1
If (Application.ActiveWindow.Selection.Item(x).MessageClass = "IPM.Schedule.Meeting.Request") Then
Set cAppt = Application.ActiveWindow.Selection.Item(x).GetAssociatedAppointment(True)
If cAppt.ResponseRequested = True Then
Set oRequest = cAppt.Respond(olMeetingAccepted, True)
oRequest.Send
End If
End If
Next x
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.
I have code that reads mail to generate a task with the mail's content.
In a few cases this hits a problem, when reading the RTFbody from the mail, saying "not implemented".
Can I test against this? Like WHEN IS NULL ... which checks if a variable has appropriate content.
Sub CreateTempTaskFromMail()
Dim oMail As Outlook.MailItem
Set oMail = ActiveInspector.CurrentItem
Dim s, sNr As String
s = oMail.subject
Dim oTask As Outlook.TaskItem
Set oTask = CreateTaskWithTempFolder(s, False) ' Function creating and returing task
oTask.RTFBody = oMail.RTFBody
End sub
I tried to test several ways if RTFbody has a problem. All of these approaches throw an error.
If oMail.RTFBody Is Nothing Then Stop
If IsError(oMail.RTFBody) Then Stop
If IsMissing(oMail.RTFBody) Then Stop
If IsEmpty(oMail.RTFBody) Then Stop
If there is absolutely no real solution then
Option Explicit
Sub CreateTempTaskFromMail()
Dim oObj As Object
Dim oMail As mailItem
Dim oTask As TaskItem
Dim s As String
Set oObj = ActiveInspector.currentItem
If oObj.Class = olMail Then
Set oMail = oObj
s = oMail.subject
Set oTask = CreateTaskWithTempFolder(s, False) ' Function creating and returing task
' If you absolutely cannot determine the problem
' https://excelmacromastery.com/vba-error-handling#On_Error_Resume_Next
On Error Resume Next
oTask.RTFBody = oMail.RTFBody
If Err <> 0 Then
Debug.Print "Error was bypassed using a technique that is to be avoided."
Exit Sub
End If
' Consider mandatory AND as soon as possible
On Error GoTo 0
oTask.Display
Else
Debug.Print "not a mailitem"
End If
End Sub
Before accessing the RTFBody property in the code I'd suggest checking the item's type first to make sure such property exists for a specific item type:
If TypeOf item Is MailItem Then
' do whatever you need with RTFBody here
End If
Or
If TypeName(item) = "MailItem" Then
' do whatever you need with RTFBody here
End If
If you are using Office 2016 product, you should update office. It is early office 2016 build's bug.
I've read this: VBA Outlook 2010 received mail .Body is empty but it is old and the other question referenced in the answer(s) is not found when I click on it.
Here's my basic code.
Sub AutoReplyTrap(objInMail As MailItem)
Dim objOutMail As Outlook.MailItem
Dim vText As Variant
Dim sText As String
Dim strID As String
Dim sSubject As String
Dim vItem As Variant
Dim vFirstName As Variant
Dim i As Long
Dim j As Integer
Dim strSignature As String
Dim strSigString As String
Dim strFirstName As String
Dim strFirstLetter As String
Dim strEMailAddress As String
Dim blnFirstName As Boolean
Dim blnEMail As Boolean
' change the bodyformat to plain text
objInMail.BodyFormat = Outlook.OlBodyFormat.olFormatPlain
objInMail.Display
blnFirstName = False
blnEMail = False
j = 0
' believe there is a timing issue that Body may not be fully loaded.
' so I'm going to pause and loop through 20 times to see if it gets loaded.
WaitForBody:
sText = objInMail.Body
If sText = "" Then
If j < 20 Then
j = j + 1
Sleep 1000
GoTo WaitForBody
End If
End If
If sText = "" Then
MsgBox ("No body in email!")
Exit Sub
End If
End Sub
I thought it was a timing issue, so I built the loop to test if I have the body, and if not, wait a second and try again up to 20 times.
I have objInMail.Display it works, but if I remove that line it will loop through the 20 attempts.
I could live with the display if I could then "un-display" it, but I wonder if the .close will close everything with the email and I'll lose the body again.
I'd prefer it to work without the objInMail.Display.
Ignoring the cause, this may provide a workaround without .Display.
Option Explicit
Private Sub test_GetInspector()
Dim currSel As Object
Set currSel = ActiveExplorer.Selection(1)
If currSel.Class = olMail Then
AutoReplyTrap_GetInspector currSel
End If
End Sub
Sub AutoReplyTrap_GetInspector(objInMail As mailItem)
' change the bodyformat to plain text
objInMail.BodyFormat = OlBodyFormat.olFormatPlain
' objInMail.GetInspector ' Previously "valid".
' My setup finally caught up and provided the clue.
' Directly replacing .Display with .GetInspector
' Compile error:
' Invalid use of property
' https://learn.microsoft.com/en-us/office/vba/api/outlook.mailitem.getinspector
Dim objInspector As Inspector
Set objInspector = objInMail.GetInspector
' You should find this is necessary
'objInMail.Save
End Sub
Working with Outlook 2010 right now and have an update. The issue is caused by a bug in Outlook 2010/2013 that only gives a blank message body in VBA when:
(1) using IMAP protocol; and,
(2) automatically processing incoming emails.
This holds true even if you just set a Rule from the front end, such as automatically printing specific incoming emails (my task). This prints the email header, not the body.
A workaround that worked for me was to use POP3 protocol instead of IMAP with the same email server.
I have a fairly straightforward VBA script that accepts meeting requests in Outlook (2013). It works fine most of the times, but for some meeting requests it gives me "object variable or with block variable not set" on this line
Set oResponse = oAppt.Respond(olMeetingAccepted, True)
I've tried to look at the different meeting requests to figure out any differences which might be triggering it but for all purposes they look like identical requests (of course they're from different senders with different subject and time, but nothing that I can see as triggering a fail).
Any thoughts what might be going on? Here's the complete Sub (it gets triggered by an outlook rule)
Sub AutoAcceptMeetings(oRequest As MeetingItem)
Dim senderName As String
Dim subjectName As String
Dim meetingTime As String
Dim senderContains As Integer
Dim subjectContains As Integer
Dim oResponse As MeetingItem
Dim oAppt As AppointmentItem
On Error GoTo debugs
If oRequest.MessageClass <> "IPM.Schedule.Meeting.Request" Then
Exit Sub
End If
Set oAppt = oRequest.GetAssociatedAppointment(True)
senderName = oRequest.senderName
subjectName = oRequest.Subject
senderContains = InStr(1, senderName, "Gina")
'Her meeting invitations don't have a reminder set.
If (senderContains > 0) Then
oAppt.ReminderSet = True
oAppt.ReminderMinutesBeforeStart = 15
End If
senderContains = InStr(1, senderName, "Jim")
If (senderContains > 0) Then 'I don't want a reminder
oAppt.ReminderSet = False
oAppt.BusyStatus = olTentative
oAppt.Save
Else 'useful meetings. accept and send response.
meetingTime = oAppt.Start
Set oResponse = oAppt.Respond(olMeetingAccepted, True)
oResponse.Send
MsgBox ("Meeting accepted " + subjectName + " from " + senderName + " for " + meetingTime)
End If
debugs:
If Err.Description <> "" Then MsgBox (Err.Description + " - Source: AutoAcceptMeetings")
End Sub
So, the issue was that I was trying to send a "response" to a meeting request that didn't require any responses. On the front end (outlook) if you accept the meeting, it goes into your calendar and the request gets deleted but no response goes to the organizer (people do that when they invite a large group and don't necessarily care to know who's attending).
Anyway, the solution for me was to put in a simple check before actually responding to the request.
If (oAppt.ResponseRequested) Then
Set oResponse = oAppt.Respond(olMeetingAccepted, True)
oResponse.Send
End If