Results 1 to 4 of 4

Thread: [RESOLVED] Delay sending Outlook meeting invites to office hours with VBA

  1. #1

    Thread Starter
    New Member
    Join Date
    Jan 2022
    Posts
    2

    Resolved [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

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    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

  3. #3

    Thread Starter
    New Member
    Join Date
    Jan 2022
    Posts
    2

    Re: Delay sending Outlook meeting invites to office hours with VBA

    Hi,

    Thanks a lot for your help! this solved the problem.

  4. #4
    New Member
    Join Date
    Feb 2022
    Posts
    1

    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
  •  



Click Here to Expand Forum to Full Width