跳至主要内容

如何在Outlook中统计花费在约会或会议上的小时数/天数/周数?

Author: Kelly Last Modified: 2025-07-31

假设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代码。

此时会弹出一个对话框,显示所选约会/会议花费了多少小时/分钟。请参见截图:

using vba to count hours/days/weeks spent on an appointment or meeting in Outlook

注意:您可以同时选择多个约会或会议,通过此VBA代码统计它们总共花费的小时数/分钟数。


相关文章

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

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

统计Outlook中“收件人”、“抄送”和“密件抄送”字段中的收件人数

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


最佳 Office 办公效率工具

重磅消息:Kutools for Outlook 推出免费版本!

体验全新 Kutools for Outlook 免费版,70 多个强大功能,永久免费使用!点击立即下载!

🤖 Kutools AI 利用先进的AI技术轻松处理邮件,包括答复、总结、优化、扩展、翻译和撰写邮件。

📧 邮件自动化自动答复(支持POP和IMAP) /计划发送邮件 /发送邮件时根据规则自动抄送密送 / 自动转发(高级规则) / 自动添加问候语 / 自动将群发邮件拆分为单独邮件 ...

📨 邮件管理撤回邮件 / 按主题等方式阻止诈骗邮件 / 删除重复邮件 / 高级搜索 / 整合文件夹 ...

📁 附件专家批量保存 / 批量拆离 / 批量压缩 / 自动保存 / 自动拆离 / 自动压缩 ...

🌟 界面魔法😊更多精美个性表情 /重要邮件来临时提醒您 / 最小化而非关闭 Outlook ...

👍 一键高效操作带附件全部答复 /反钓鱼邮件 / 🕘显示发件人时区 ...

👩🏼‍🤝‍👩🏻 联系人与日历从选中的邮件批量添加联系人 / 将联系人组拆分为多个独立组 / 移除生日提醒 ...

使用 Kutools,支持英语、西班牙语、德语、法语、中文及40 多种其他语言,满足您的语言偏好!

一键解锁 Kutools for Outlook。无需等待,立即下载,提升办公效率!

kutools for outlook features1 kutools for outlook features2