outlook2016把日历导出html,如何将Outlook日历导出到Excel每周时间表？

R3uK..

10

一个简单的谷歌搜索,一点点重构:

Option Explicit

Sub ListAppointments()

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

FromDate = CDate("08/25/2017")

ToDate = CDate("12/31/2017")

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")

Set olFolder = olNS.GetDefaultFolder(9) 'olFolderCalendar

NextRow = 2

With Sheets("Sheet1") 'Change the name of the sheet here

.Range("A1:D1").Value = Array("Project", "Date", "Time spent", "Location")

For Each olApt In olFolder.Items

If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then

.Cells(NextRow, "A").Value = olApt.Subject

.Cells(NextRow, "B").Value = CDate(olApt.Start)

.Cells(NextRow, "C").Value = olApt.End - olApt.Start

.Cells(NextRow, "C").NumberFormat = "HH:MM:SS"

.Cells(NextRow, "D").Value = olApt.Location

.Cells(NextRow, "E").Value = olApt.Categories

NextRow = NextRow + 1

Else

End If

Next olApt

.Columns.AutoFit

End With

Set olApt = Nothing

Set olFolder = Nothing

Set olNS = Nothing

Set olApp = Nothing

End Sub

这在Office 2016中仍然运行良好!我添加了这一行:`.Cells(NextRow,"E").Value = olApt.Categories`如果你想为不同的项目分类你的会议等. (2认同)