How to Quickly Export the Statistics of Appointments in a Specific Period via Outlook VBA

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”.

Quickly Export the Statistics of Appointments in a Specific Period via Outlook VBA

Export the Statistics of Appointments in a Specific Period

  1. At the very beginning, start your Outlook program.
  2. Then, press “Alt + F11” key buttons to access Outlook VBA editor.
  3. 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

VBA Code - Export the Statistics of Appointments in a Specific Period

  1. After that, you can run this macro by pressing “F5” key button in the current module.
  2. Later, you will be required to specify the date range.Specify Date Range
  3. 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:Exported Appointment Counts

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.

Author Introduction:

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