我一直在使用下面的代码来按类别计算 2 个日期之间花费的总小时数。它运行良好，现在我正在寻找一种方法，不仅可以运行此代码，还可以将收集的数据导出到特定的 Excel 工作表。下面的代码是否有一个简单的补充，或者我必须有一个完全不同的子？
Sub TotalCategories()
Dim app As New Outlook.Application
Dim namespace As Outlook.namespace
Dim calendar As Outlook.Folder
Dim appt As Outlook.AppointmentItem
Dim apptList As Outlook.Items
Dim apptListFiltered As Outlook.Items
Dim explorer As Outlook.explorer
Dim view As Outlook.view
Dim calView As Outlook.CalendarView
Dim startDate As String
Dim endDate As String
Dim category As String
Dim duration As Integer
Dim outMsg As String
' Access appointment list
Set namespace = app.GetNamespace("MAPI")
Set calendar = namespace.GetDefaultFolder(olFolderCalendar)
Set apptList = calendar.Items
' Include recurring appointments and sort the list
apptList.IncludeRecurrences = True
apptList.Sort "[Start]"
' Get selected date
Set explorer = app.ActiveExplorer()
Dim dte As String
startDate = InputBox("Please Enter Start Date: ", Default:=Format(Now, "mm/dd/yyyy"))
endDate = InputBox("Please Enter End Date: ", Default:=Format(Now, "mm/dd/yyyy"))
' Filter the appointment list
strFilter = "[Start] >= '" & startDate & "'" & " AND [End] <= '" & endDate & "'"
Set apptListFiltered = apptList.Restrict(strFilter)
' Loop through the appointments and total for each category
Set catHours = CreateObject("Scripting.Dictionary")
For Each appt In apptListFiltered
category = appt.Categories
duration = appt.duration
If catHours.Exists(category) Then
catHours(category) = catHours(category) + duration
Else
catHours.Add category, duration
End If
Next
' Loop through the categories
keyArray = catHours.Keys
For Each Key In keyArray
outMsg = outMsg & Key & ": " & (catHours(Key) / 60) & vbCrLf & vbCrLf
Next
' Display final message
MsgBox outMsg, , "Category Totals"
' Clean up objects
Set app = Nothing
Set namespace = Nothing
Set calendar = Nothing
Set appt = Nothing
Set apptList = Nothing
Set apptListFiltered = Nothing
Set explorer = Nothing
Set view = Nothing
Set calView = Nothing
End Sub