If you want to count the appointments per day in a specific date range and export the results to an Excel file, you can use the smart way introduced in this article. It can accomplish this in quick time.
Sometimes, you may need to count the appointments per day. Of course, you can choose to count manually. However, it is still a bit troublesome and error prone if there are too many appointments in your calendar. Hence, you had better search any more effective means, such as the following one, which is using VBA code. As for how to make use of VBA code in Outlook, you can refer to the article – ‘How to Run VBA Code in Your Outlook”.
Export the Statistics of Appointments in a Specific Period
- At the very beginning, start your Outlook program.
- Then, press “Alt + F11” key buttons to access Outlook VBA editor.
- Subsequently, copy and paste the following VBA code into an unused project or module.
Sub ExportCountOfEverydayAppointmentsinSpecificDateRange() Dim dStart, dEnd, dDate As Date Dim objExcelApp As Excel.Application Dim objExcelWorkbook As Excel.Workbook Dim objExcelWorksheet As Excel.Worksheet Dim objAppointments, objRestrictAppointments As Outlook.Items Dim strFilter As String Dim nLastRow As Integer Dim objItem As Object Dim lCount As Long 'Specify the date range dStart = InputBox("Specify the start date:", , Format(Now, "Short Date")) dEnd = InputBox("Enter the end date:", , Format(Now + 30, "Short Date")) 'Create an Excel file Set objExcelApp = CreateObject("Excel.Application") Set objExcelWorkbook = objExcelApp.Workbooks.Add Set objExcelWorksheet = objExcelWorkbook.Worksheets(1) objExcelApp.Visible = True objExcelWorkbook.Activate 'Specify the fields With objExcelWorksheet .Cells(1, 1) = "Date" .Cells(1, 1).Font.Bold = True .Cells(1, 1).Font.Size = 13 .Cells(1, 2) = "Appointment Count" .Cells(1, 2).Font.Bold = True .Cells(1, 2).Font.Size = 13 End With Set objAppointments = Application.Session.GetDefaultFolder(olFolderCalendar).Items objAppointments.Sort "[Start]" objAppointments.IncludeRecurrences = True dDate = dStart 'Export the count of everyday appointments in the specific date range Do Until dDate > dEnd strFilter = "[Start] <= " & Chr(34) & dDate & " 11:59 PM" & Chr(34) & " AND [End] >= " & Chr(34) & dDate & " 00:00 AM" & Chr(34) Set objRestrictAppointments = objAppointments.Restrict(strFilter) For Each objItem In objRestrictAppointments lCount = lCount + 1 Next nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1 objExcelWorksheet.Cells(nLastRow, 1) = dDate objExcelWorksheet.Cells(nLastRow, 2) = lCount dDate = dDate + 1 lCount = 0 objExcelWorksheet.Columns("A:B").AutoFit Loop End Sub
- After that, you can run this macro by pressing “F5” key button in the current module.
- Later, you will be required to specify the date range.
- At once, an Excel file will show up, which is recording the count of everyday appointments in specific date range. It looks like the following screenshot:
Restore Compromised Outlook File
Even though Outlook satisfies quantities of our needs, it’s still vulnerable to many factors, including power outage, virus infection, hardware malfunction and other issues. Therefore, it’s highly suggested to keep a potent repair tool in vicinity, like DataNumen Outlook Repair. It is particularly designed to repair Outlook troubles.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including mdf recovery and outlook repair software products. For more information visit www.datanumen.com