如何在Outlook中统计花费在约会或会议上的小时数/天数/周数?
假设Outlook日历中有许多约会与会议。现在,您想统计花费在这些约会和会议上的小时数/天数/周数,有什么办法吗?本文将介绍一个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中“收件人”、“抄送”和“密件抄送”字段中的收件人数
最佳 Office 办公效率工具
重磅消息:Kutools for Outlook 推出免费版本!
体验全新 Kutools for Outlook 免费版,70 多个强大功能,永久免费使用!点击立即下载!
🤖 Kutools AI :利用先进的AI技术轻松处理邮件,包括答复、总结、优化、扩展、翻译和撰写邮件。
📧 邮件自动化:自动答复(支持POP和IMAP) /计划发送邮件 /发送邮件时根据规则自动抄送密送 / 自动转发(高级规则) / 自动添加问候语 / 自动将群发邮件拆分为单独邮件 ...
📨 邮件管理:撤回邮件 / 按主题等方式阻止诈骗邮件 / 删除重复邮件 / 高级搜索 / 整合文件夹 ...
📁 附件专家:批量保存 / 批量拆离 / 批量压缩 / 自动保存 / 自动拆离 / 自动压缩 ...
🌟 界面魔法:😊更多精美个性表情 /重要邮件来临时提醒您 / 最小化而非关闭 Outlook ...
👍 一键高效操作:带附件全部答复 /反钓鱼邮件 / 🕘显示发件人时区 ...
👩🏼🤝👩🏻 联系人与日历:从选中的邮件批量添加联系人 / 将联系人组拆分为多个独立组 / 移除生日提醒 ...
使用 Kutools,支持英语、西班牙语、德语、法语、中文及40 多种其他语言,满足您的语言偏好!
一键解锁 Kutools for Outlook。无需等待,立即下载,提升办公效率!

