如何统计在 Outlook 中某个约会或会议上所花费的小时数、天数或周数？

假如您在 Outlook 日历中有大量约会和会议，现在希望统计这些约会和会议所花费的小时数、天数或周数，有什么方法可以实现？本文将为您介绍一段 VBA 代码，助您轻松完成统计。

使用 VBA 统计在约会或会议上花费的小时/天/周数

---

使用 VBA 统计在约会或会议上花费的小时/天/周数

本方法将为您介绍一段 VBA 代码，助您轻松统计 Outlook 中指定约会或会议所耗费的小时数或分钟数。请按照以下步骤操作：

1. 切换到日历文件夹，然后点击选择您希望统计所花费小时数的约会或会议。

2. 请同时按下 Alt+F11 键，即可打开 Microsoft Visual Basic for Applications 窗口。

3. 点击插入 > 模块，然后将以下 VBA 代码粘贴到打开的模块窗口中。

VBA：统计在 Outlook 中约会或会议所花费的小时/分钟数

Sub CountTimeSpent()
Dim oOLApp As Outlook.Application
Dim oSelection As Outlook.Selection
Dim oItem As Object
Dim iDuration As Long
Dim iTotalWork As Long
Dim iMileage As Long
Dim iResult As Integer
Dim bShowiMileage As Boolean

bShowiMileage = False

iDuration = 0
iTotalWork = 0
iMileage = 0

On Error Resume Next

    Set oOLApp = CreateObject("Outlook.Application")
Set oSelection = oOLApp.ActiveExplorer.Selection

    For Each oItem In oSelection
If oItem.Class = olAppointment Then
iDuration = iDuration + oItem.Duration
iMileage = iMileage + oItem.Mileage
ElseIf oItem.Class = olTask Then
iDuration = iDuration + oItem.ActualWork
iTotalWork = iTotalWork + oItem.TotalWork
iMileage = iMileage + oItem.Mileage
ElseIf oItem.Class = Outlook.olJournal Then
iDuration = iDuration + oItem.Duration
iMileage = iMileage + oItem.Mileage
Else
iResult = MsgBox("Please select some Calendar, Task or Journal items at first!", vbCritical, "Items Time Spent")
Exit Sub
End If
Next

Dim MsgBoxText As String
MsgBoxText = "Total time spent: " & vbNewLine & iDuration & " minutes"

If iDuration > 60 Then
MsgBoxText = MsgBoxText & HoursMsg(iDuration)
End If

If iTotalWork > 0 Then
MsgBoxText = MsgBoxText & vbNewLine & vbNewLine & "Total work recorded; " & vbNewLine & iTotalWork & " minutes"

If iTotalWork > 60 Then
MsgBoxText = MsgBoxText & HoursMsg(iTotalWork)
End If
End If

If bShowiMileage = True Then
MsgBoxText = MsgBoxText & vbNewLine & vbNewLine & "Total iMileage; " & iMileage
End If

    iResult = MsgBox(MsgBoxText, vbInformation, "Items Time spent")

ExitSub:
Set oItem = Nothing
Set oSelection = Nothing
Set oOLApp = Nothing
End Sub

Function HoursMsg(TotalMinutes As Long) As String
Dim iHours As Long
Dim iMinutes As Long
iHours = TotalMinutes \ 60
iMinutes = TotalMinutes Mod 60
HoursMsg = " (" & iHours & " Hours and " & iMinutes & " Minutes)"
End Function

4. 请按下 F5 键，或点击运行按钮即可运行此 VBA。

此时将弹出一个对话框，显示所选约会或会议所用的小时数或分钟数，如下图所示：

注意：您可以同时选择多个约会或会议，使用此 VBA 代码统计它们所花费的总小时数或分钟数。

---

相关文章

统计 Outlook 文件夹中的对话数量总数

统计 Outlook 中选中邮件的附件总数

统计在 Outlook 的收件人、抄送和密送栏中的收件人数

统计 Outlook 中按发件人分类的邮件数数量