☰

如何使用 Excel 从 MS Outlook 日历生成时间表？

tag-icon • tag-icon microsoft-excel microsoft-outlook vba power-query
如何使用 Excel 从 MS Outlook 日历生成时间表？

这个问题主要想分享一下我的想法。

我每天都很难填写时间表。我每天的工作时间都不一样，月底我必须提交 Excel 时间表，以显示我的加班时间是否与“不足时间”相平衡，以及我最终应该计算多少小时。我没有时间每天打开特殊工具或网页并输入这个时间。所以我想出了一个主意，在 Outlook 中按日填写时间表并将其导出到 Excel。整个概念对我来说已经很好了，所以我想和你分享这个想法。

一开始我实际上是将 Outlook Calendat 导出到 csv，导入到 Excel 等等……但作为程序员，我不喜欢重复同样的工作，所以我决定自动化这个过程。尤其是当 Excel VBA 可以直接从 Outlook 读取时，
我无法将带有 VBA 代码的现成 Excel 上传到任何地方，所以我使用的所有方法都将在回答这个“问题”时描述。不幸的是，像 Fieldglass 这样的工具没有导入功能，不能直接使用 excel，但无论如何它还是有帮助的。

那么..让我们开始吧...

答案1

想法是使用 Outlook 日历作为输入工作时间的工具。为什么是 Outlook？因为我一直打开它，它可以提醒我调整当天或前一天的时间。您不需要打开任何其他工具。您可以手动输入时间，也可以使用复制粘贴或拖放。用鼠标更改开始和结束时间。首先，我们需要单独的日历，以便用于输入工作时间的约会。

  1. 让我们创建日历“工作时间表”（您可以将其命名为不同的名字，但要相应地调整 VBA）。如果经理想知道您每天工作多长时间，您也可以与他分享。
  2. 创建主题为“工作”的约会，开始和结束时间都在我们的“默认”工作时间内。它可以有提醒功能，这样 Outlook 就会提醒您，如果需要，我们应该调整时间。它应该是重复的。每周，我们一周中的每一天都工作。（它是模板，如果需要，我们可以在周末添加后续工作）。重复的结束时间由您决定。最好不要夸大其词，因为 VBA 必须检查所有约会才能从这个月开始找到这个约会。将来，您可以删除此日历并创建具有相同规则的新日历。如果您每天都有午休时间，您可以每天创建 2 个工作约会。
  3. 定期会议很容易添加，但用处不大。最好只开一次会议。为此，我们必须将日历导出到 csv。导出时单击“映射自定义字段”，然后选择主题、开始日期、开始时间、结束时间、提醒开/关、提醒日期和时间。写入文件 CSV 文件并导入回 Outlook 工作时间表日历。然后删除定期会议。
  4. 我们只需调整“工作”预约即可输入工作时间。如果需要，我们可以在一天内安排多个预约。您可以使用鼠标或编辑预约
  5. 如果我们不工作，但这是正常工作日，则更改以“免费”为准
  6. 如果今天是空闲日，但您有工作，请与主题“WORK OVER”6a 预约。您可以在“视图/当前视图/视图设置/其他设置”中更改日历的时间刻度，但您可能还需要更改字体以适应屏幕上的日历。不幸的是，这会影响所有日历。在视图/时间刻度中，您可以切换到 15 分钟以调整日期，然后切换回 30 分钟。
  7. 现在我们需要 Excel 和一些 VBA 以及 PowerQuery 来进行计算。我无法上传现成的 Excel，因此我在下面输入了 VBA 代码和 Power Query M 脚本。
  8. 创建包含 2 个工作表的 Excel：Timesheet 和 Calc。
  9. 在“时间表”表中创建表（ListObject）“时间表”，其中只有 3 列：主题、开始日期时间、结束日期时间。
  10. 单击“时间表”表，转到数据/获取数据/从表/范围
  11. 在 Power Query 中单击“高级编辑器”并从下方粘贴 M 脚本。
  12. 在关闭并加载中单击向下箭头并选择关闭并加载到。
  13. 选择表格、现有工作表，然后选择 Calc 工作表中的单元格 A3。（为按钮留出一些空间）
  14. Calc 表应该在重要列中有一些总计，并在表设计 15 中将其命名为“Timesheet_calc” 在 Calc 表的某处插入一个将触发宏的按钮（下面的 VBA） 这或多或少就是一切。当然，我的代码可以改进。我看到了很多可能性，但我没有太多时间进行所有可能的“好”更改。我的 VBA 此外：
  • 允许选择是针对本月还是上个月进行计算
  • 添加新的月份工作表，并将 Timesheet 和 Calc 中的值和格式复制到此工作表，以制作存档或历史记录约会：WORK 被视为工作，因此计算每日工作时间加班和不足时间。FREE 不被视为工作，但它是工作日，因此计算不足时间 WORK OVERTIME 被视为工作，但标准时间为 0，因此计算加班时间（例如，在空闲日工作）不要在一天内混合类型。FREE 可以只是 1 小时或 30 分钟，没有必要。无论如何，这个时间被视为 0。 这是 Excel 文件的链接（带有 VBA 和 PowerQuery）

VBA：

   Sub Timesheet_import()
        Dim olApp As Object
        Dim olNS As Object
        Dim olFolder As Object
        Dim olApt As Object
        Dim NextRow As Long
        Dim FromDate As Date
        Dim ToDate As Date
        Dim sDate As Date
        sMonth = MsgBox("Shell I use preasent month? " & vbCr & "Yes: This month" & vbCr & "No: Previous month", vbQuestion + vbYesNo)
        If sMonth = 6 Then sDate = Now()
        If sMonth = 7 Then sDate = DateAdd("m", -1, Now())
        FromDate = DateSerial(Year(sDate), Month(sDate), 1)
        ToDate = Excel.Application.WorksheetFunction.EoMonth(sDate, 0)
        On Error Resume Next
        Set olApp = GetObject(, "Outlook.Application")
        If Err.Number > 0 Then Set olApp = CreateObject("Outlook.Application")
        On Error GoTo 0
        Set olNS = olApp.GetNamespace("MAPI")
        NextRow = 2
        Set olFolder = olNS.GetDefaultFolder(9)
        For Each CalendarFolder In olFolder.Folders
        If CalendarFolder.Name = "Work Timesheet" Then GoTo endLoop
        Next
        endLoop:
        Set olFolder = CalendarFolder
        With ActiveWorkbook.Sheets("Timesheet").ListObjects("Timesheet") Set newRow = .ListRows.Add()
        .DataBodyRange.Delete
        For Each olApt In olFolder.Items
        If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
        Set newRow = .ListRows.Add()
        With newRow
        .Range(1) = olApt.Subject
        .Range(2) = CDate(olApt.Start)
        .Range(3) = CDate(olApt.End)
        End With
        End If
        Next olApt
        End With
        ActiveWorkbook.Sheets("Calc").ListObjects("Timesheet_calc").QueryTable.Refresh BackgroundQuery:=False
        ActiveSheet.Columns.AutoFit
        Set olApt = Nothing
        Set olFolder = Nothing
        Set olNS = Nothing
        Set olApp = Nothing
        Dim NameNew As String
        NameNew = Year(sDate) & "-" & Month(sDate)
        If WorksheetExists(NameNew) Then
        Sheets(NameNew).Delete
        End If
        lastsheet = Sheets.Count
        Set NewSheet = ActiveWorkbook.Sheets.Add(After:=Sheets(lastsheet))
        NewSheet.Name = NameNew
        Range("Timesheet_calc[#All]").Copy
        NewSheet.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        NewSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
        NewSheet.Range("A1").PasteSpecial Paste:=xlPasteFormats
        Range("Timesheet[#All]").Copy
        NewSheet.Range("K1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        NewSheet.Range("K1").PasteSpecial Paste:=xlPasteColumnWidths
        NewSheet.Range("K1").PasteSpecial Paste:=xlPasteFormats
        End Sub
        Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
            Dim sht As Worksheet
            If wb Is Nothing Then Set wb = ThisWorkbook
            On Error Resume Next
            Set sht = wb.Sheets(shtName)
            On Error GoTo 0
            WorksheetExists = Not sht Is Nothing
        End Function

Power Query 的 M 脚本

let
    Source = Excel.CurrentWorkbook(){[Name="Timesheet"]}[Content],
    #"Added Custom" = Table.AddColumn(Source, "Start Date", each Date.From([StartDateTime])),
     #"Added Custom2" = Table.AddColumn(#"Added Custom" , "Start Time", each Time.From([StartDateTime])),
     #"Added Custom3" = Table.AddColumn(#"Added Custom2" , "End Time", each Time.From([EndDateTime])),
    #"Changed Type" = Table.TransformColumnTypes(#"Added Custom3",{{"Start Time", type time}, {"End Time", type time}, {"Start Date", type date}}),
    #"Removed Columns" = Table.RemoveColumns(#"Changed Type",{"StartDateTime", "EndDateTime"}),
    mSort = Table.Sort(#"Removed Columns",{{"Start Date", Order.Ascending}, {"Start Time", Order.Ascending}}),
    WorkTime = Table.AddColumn(mSort, "WorkTime", each if [Subject] = "WORK" or [Subject]="WORK OVER" then [End Time]-[Start Time] else "00:00:00"),
    WorkTimeType = Table.TransformColumnTypes(WorkTime,{{"WorkTime", type duration}}),
    #"Grouped Rows" = Table.Group(WorkTimeType, {"Start Date"}, {{"Subject", each List.Min([Subject]), type text}, {"Start Time", each List.Min([Start Time]), type nullable time}, {"End Time", each List.Max([End Time]), type nullable time}, {"Work Time", each List.Sum([WorkTime]), type nullable duration}}),
    StandardTime = Table.AddColumn(#"Grouped Rows", "Standard time", each if [Subject]="WORK" or [Subject]="FREE" then "08:00:00" else "00:00:00"),
    StandardTimeType = Table.TransformColumnTypes(StandardTime,{{"Standard time", type duration}}),
    OverTime = Table.AddColumn(StandardTimeType, "OverTime", each if[Work Time]-[Standard time]>=Duration.From("00:00:00")  then [Work Time]-[Standard time] else "00:00:00"),
    OverTimeType = Table.TransformColumnTypes(OverTime,{{"OverTime", type duration}}),
    UnderTime = Table.AddColumn(OverTimeType, "UnderTime", each if[Work Time]-[Standard time]<Duration.From("00:00:00")  then -[Work Time]+[Standard time] else "00:00:00"),
    UnderTimeType = Table.TransformColumnTypes(UnderTime,{{"UnderTime", type duration}}),
    OverTimeDecimal = Table.AddColumn( UnderTimeType, "OverTime Hours Number", each Duration.Hours([OverTime]-[UnderTime])+Duration.Minutes([OverTime]-[UnderTime])/60),
    WorkTimeDecimal = Table.AddColumn( OverTimeDecimal, "WorkTime Hours Number", each Duration.Hours([Work Time])+Duration.Minutes([Work Time])/60)
in
    WorkTimeDecimal

外表

Excel

答案2

感谢 gns100，我做了一些调查，发现不需要 VBA。Power Query 可以访问 Exchange 服务器并直接下载这些数据。在下面的代码中，您需要将电子邮件和日历名称更改为您自己的日历名称必须从日历的属性中获取，而不是 GUI 中可见的文本。我稍后会分享现成的 Excel，但没有参数的 M 脚本看起来很简单：

let
    Source = Exchange.Contents("username@domainname"),
    GetCalendars = Source{[Name="Calendar"]}[Data],
    SelectCalendar = Table.SelectRows(GetCalendars, each ([Folder Path] = "\Calendar\Work Timesheet\")),
    SelectColumns = Table.SelectColumns(SelectCalendar,{"Subject", "Start", "End"}),
    #"Filtered Rows1" = Table.SelectRows(SelectColumns, each Date.IsInCurrentMonth([Start])),
    #"Sorted Rows" = Table.Sort(#"Filtered Rows1",{{"Start", Order.Ascending}}),
    #"Added Custom_0" = Table.AddColumn(#"Sorted Rows", "Start Date", each Date.From([Start])),
     #"Added Custom2" = Table.AddColumn(#"Added Custom_0" , "Start Time", each Time.From([Start])),
     #"Added Custom3" = Table.AddColumn(#"Added Custom2" , "End Time", each Time.From([End])),
    #"Changed Type" = Table.TransformColumnTypes(#"Added Custom3",{{"Start Time", type time}, {"End Time", type time}, {"Start Date", type date}}),
    #"Removed Columns" = Table.RemoveColumns(#"Changed Type",{"Start", "End"}),
    mSort = Table.Sort(#"Removed Columns",{{"Start Date", Order.Ascending}, {"Start Time", Order.Ascending}}),
    WorkTime = Table.AddColumn(mSort, "WorkTime", each if [Subject] = "WORK" or [Subject]="WORK OVER" then [End Time]-[Start Time] else "00:00:00"),
    WorkTimeType = Table.TransformColumnTypes(WorkTime,{{"WorkTime", type duration}}),
    #"Grouped Rows" = Table.Group(WorkTimeType, {"Start Date"}, {{"Subject", each List.Min([Subject]), type text}, {"Start Time", each List.Min([Start Time]), type nullable time}, {"End Time", each List.Max([End Time]), type nullable time}, {"Work Time", each List.Sum([WorkTime]), type nullable duration}}),
    StandardTime = Table.AddColumn(#"Grouped Rows", "Standard time", each if [Subject]="WORK" or [Subject]="FREE" then "08:00:00" else "00:00:00"),
    #"Added Custom1" = Table.AddColumn(StandardTime, "Work Day", each if[Standard time]>"00:00:00" then 1 else null),
    StandardTimeType = Table.TransformColumnTypes(#"Added Custom1",{{"Standard time", type duration}}),
    OverTime = Table.AddColumn(StandardTimeType, "OverTime", each if[Work Time]-[Standard time]>=Duration.From("00:00:00")  then [Work Time]-[Standard time] else "00:00:00"),
    OverTimeType = Table.TransformColumnTypes(OverTime,{{"OverTime", type duration}}),
    UnderTime = Table.AddColumn(OverTimeType, "UnderTime", each if[Work Time]-[Standard time]<Duration.From("00:00:00")  then -[Work Time]+[Standard time] else "00:00:00"),
    UnderTimeType = Table.TransformColumnTypes(UnderTime,{{"UnderTime", type duration}}),
    OverTimeDecimal = Table.AddColumn( UnderTimeType, "OT Hrs Cnt", each Duration.Hours([OverTime]-[UnderTime])+Duration.Minutes([OverTime]-[UnderTime])/60),
    WorkTimeDecimal = Table.AddColumn( OverTimeDecimal, "WT Hrs Cnt", each Duration.Hours([Work Time])+Duration.Minutes([Work Time])/60)
in
    WorkTimeDecimal

相关内容