How to Get Warned when Too Many Appointments Are Scheduled on the Same Day in Your Outlook

This article will introduce a method, which can let Outlook automatically warn you when there are too many appointments scheduled on the same day.

Without any doubts, you have no enough time and energy to deal with too many appointments in one day. Thus, in order to better manage your working as well as avoid over fatigue, you’d better schedule a certain number of appointments in one day only. If you are a regular user of Outlook, you must be used to organizing all of your appointments in your outlook calendar. In this situation, you may hope that as soon as a new appointment is added to one day, Outlook can auto count the appointments on this day. Then, if the total count is over a predefined number, Outlook can pop up a warning. Focused on this requirement, in the followings, we will introduce you the elaborate steps and VBA codes.

Get Warned when Too Many Appointments Are Scheduled on the Same Day

1. In the first place, launch your Outlook application.
2. Then in the Outlook window, press “Alt + F11” key buttons.
3. In the next VBA editor window, open the “ThisOutlookSession” project.
4. Subsequently, copy and paste the following VBA codes into it.

Public WithEvents objAppointments As Outlook.Items

Private Sub Application_Startup()
    Set objAppointments = Outlook.Application.Session.GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub objAppointments_ItemAdd(ByVal objItem As Object)
    Dim objAppointment As Outlook.AppointmentItem
    Dim strAppointmentDate As String
    Dim strFilter As String
    Dim objRestrictAppointments As Outlook.Items
    Dim lAppointmentCount As Long
    Dim strMsg As String
    Dim nWarning As Integer

    Set objAppointment = objItem
    strAppointmentDate = Format(objAppointment.Start, "yyyy/mm/dd")
 
    'Get all the appointments scheduled on the specific day
    strFilter = "[Start] <= " & Chr(34) & strAppointmentDate & " 11:59 PM" & Chr(34) & " AND [End] > " & Chr(34) & strAppointmentDate & " 00:00 AM" & Chr(34)
    Set objRestrictAppointments = objAppointments.Restrict(strFilter)
 
    lAppointmentCount = objRestrictAppointments.Count
    'You can change the specific number "5" as per your needs
    If lAppointmentCount >= 5 Then
       strMsg = "You have scheduled " & lAppointmentCount & " appointments on " & strAppointmentDate & "." & vbCrLf & "Do you want to still add the new one?"
       nWarning = MsgBox(strMsg, vbExclamation + vbYesNo, "Count Appointments") 
       If nWarning = vbNo Then
          objItem.Delete
       End If
    End If
End Sub

5. After that, you should proceed to sign this code.
6. Later change your Outlook macro settings to permit the digitally signed VBA project.
7. Eventually restart outlook to enable the new macro.
8. From now on, every time you add new appointment, Outlook will auto count the appointments on that day. If the count exceeds a predefined number, you will get a warning, like the screenshot below:
9. If you select ‘No”, the new appointment will be deleted.

Fight against Vexing PST Issues

Various PST issues can occur from time to time. Therefore, Outlook offers users an inbox repair tool, Scanpst.exe. However, it is not powerful enough to deal with serious problems, such as PST file corruption. Under that circumstance, your last resort is to use a more experienced and reputable tool, like DataNumen Outlook Repair.

Author Introduction:

Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including sql fix and outlook repair software products. For more information visit www.datanumen.com