-
Jan 16th, 2022, 03:41 AM
#1
Thread Starter
New Member
[RESOLVED] Delay sending Outlook meeting invites to office hours with VBA
Hi,
I've a code to delay the sending of e-mails to office hours in Outlook by using VBA, which I think is great. I also would like to delay all my meeting invite, responses and forwarding of invites.
In the code below, the green part is for delaying e-mails which is working, the red part is for delaying meetings which is not (yet) working. The issue seems to be within the function part. I've tried both with the AppointmentItem and the MeetingItem but in both case the function part won't return an active inspector.
Thanks for any help! Let me know if any further clarification is needed.
Dim objMail As Object
Dim objMeeting As Object
Dim Mail As Outlook.MailItem
Dim Meeting As Outlook.MeetingItem
Dim WkDay As Integer
Dim MinNow As Integer
Dim SendHour As Integer
Dim SendDate As Date
Dim SendNow As String
Dim UserDeferOption As Integer
Function getActiveMessageMail() As Outlook.MailItem
Dim insp As Outlook.Inspector
If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
Set insp = Application.ActiveWindow
End If
If insp Is Nothing Then
Dim inline As Object
Set inline = Application.ActiveExplorer.ActiveInlineResponse
If inline Is Nothing Then Exit Function
Set getActiveMessageMail = inline
Else
Set insp = Application.ActiveInspector
If insp.CurrentItem.Class = olMail Then
Set getActiveMessageMail = insp.CurrentItem
Else
Exit Function
End If
End If
End Function
Function getActiveMessageMeeting() As Outlook.MeetingItem
Dim inspMeeting As Outlook.Inspector
If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
Set inspMeeting = Application.ActiveWindow
End If
If inspMeeting Is Nothing Then
Dim inline As Object
Set inline = Application.ActiveExplorer.ActiveInlineResponse
If inline Is Nothing Then Exit Function
Set getActiveMessageMeeting = inline
Else
Set inspMeeting = Application.ActiveInspector
If inspMeeting.CurrentItem.Class = olMeetingRequest Then
Set getActiveMessageMeeting = inspMeeting.CurrentItem
Else
Exit Function
End If
End If
End Function
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'On Error GoTo ErrorHandler
'This sub used to delay the sending of an email from send time to the next work day at 8am.
'Set Variables
SendDate = Now()
SendHour = Hour(Now)
MinNow = Minute(Now)
WkDay = Weekday(Now)
SendNow = "Y"
'Check if Before 7am
If SendHour < 7 Then
MsgBox ("Before seven")
SendHour = 8 - SendHour
SendDate = DateAdd("h", SendHour, SendDate)
SendDate = DateAdd("n", -MinNow, SendDate)
SendNow = "N"
End If
'Check if after 7PM other than Friday
If SendHour >= 19 Then 'After 7 PM
SendHour = 32 - SendHour 'Send a 8 am next day
SendDate = DateAdd("h", SendHour, SendDate)
SendDate = DateAdd("n", -MinNow, SendDate)
SendNow = "N"
End If
'Check if Sunday
If WkDay = 1 Then
SendDate = Now()
SendHour = Hour(Now)
SendDate = DateAdd("d", 1, SendDate)
SendDate = DateAdd("h", 8 - SendHour, SendDate)
SendDate = DateAdd("n", -MinNow, SendDate)
SendNow = "N"
End If
'Check if Saturday
If WkDay = 7 Then
SendDate = Now()
SendHour = Hour(Now)
SendDate = DateAdd("d", 2, SendDate)
SendDate = DateAdd("h", 8 - SendHour, SendDate)
SendDate = DateAdd("n", -MinNow, SendDate)
SendNow = "N"
End If
'Check if Friday after 7pm
If WkDay = 6 And SendHour >= 19 Then 'After 7pm Friday
SendDate = Now()
SendHour = Hour(Now)
SendDate = DateAdd("d", 3, SendDate)
SendDate = DateAdd("h", 8 - SendHour, SendDate)
SendDate = DateAdd("n", -MinNow, SendDate)
SendNow = "N"
End If
'Send the Email
Set objMail = getActiveMessageMail()
If objMail Is Nothing Then
'Do nothing - as this is likely a calendar issue
'MsgBox "No active inspector"
Else
If TypeOf objMail Is Outlook.MailItem Then
Set Mail = objMail
'Check if we need to delay delivery
If SendNow = "N" Then
UserDeferOption = MsgBox("Do you want to postpone sending until work hours (" & SendDate & ")?", vbYesNo + vbQuestion, "Time to stop working!")
If UserDeferOption = vbYes Then
Mail.DeferredDeliveryTime = SendDate
'MsgBox ("Your mail will be sent at: " & SendDate)
Else
End If
End If
End If
End If
'Send the Meeting
Set objMeeting = getActiveMessageMeeting()
If objMeeting Is Nothing Then
'Do nothing - as this is likely a calendar issue
MsgBox "No active inspector"
Else
If TypeOf objMeeting Is Outlook.MeetingItem Then
Set Meeting = objMeeting
'Check if we need to delay delivery
If SendNow = "N" Then
UserDeferOption = MsgBox("Do you want to postpone sending until work hours (" & SendDate & ")?", vbYesNo + vbQuestion, "Time to stop working!")
If UserDeferOption = vbYes Then
Mail.DeferredDeliveryTime = SendDate
'MsgBox ("Your mail will be sent at: " & SendDate)
Else
End If
End If
End If
End If
Exit Sub
'ErrorHandler:
' MsgBox "Error!"
End Sub
-
Jan 16th, 2022, 05:08 AM
#2
Re: Delay sending Outlook meeting invites to office hours with VBA
i am not sure why you should need to get the activeinspector for the mail item or meeting item as the required object is passed to the item_send procedure as ITEM
all you should need is after the code to set the senddate is
Code:
If sendnow = "N" Then
If Item.Class = olMail Or Item.Class = olMeetingRequest Then Item.DeferredDeliveryTime = senddate ' NOTE there are several classes of meeting items, you will need to test if this is the correct item class for what you want or you can cover more objects in case
End If
which should work with some small adjustments for both mail items and meeting requests, just addin your messageboxes etc
none of the code in red or green should actually be required
test it out, see how you go
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 16th, 2022, 09:00 AM
#3
Thread Starter
New Member
Re: Delay sending Outlook meeting invites to office hours with VBA
Hi,
Thanks a lot for your help! this solved the problem.
-
Feb 2nd, 2022, 01:54 AM
#4
New Member
Re: Delay sending Outlook meeting invites to office hours with VBA
RW999 I am looking to do the same, could you please post the final version of your code ? Cheers
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|