|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
简单的做了一个。
Sub GetOutlookAppiontment()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim olFldr As MAPIFolder
Dim olApt As AppointmentItem
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderCalendar)
Dim arr As Variant
i = 1
For Each olApt In olFldr.Items
With olApt
arr2 = Array(i, .Subject, .Body, .Start, .Duration, .End, .ReminderMinutesBeforeStart, .Location, .Categories)
Sheet2.Cells(i + 1, 1).Resize(1, UBound(arr2) + 1) = arr2
i = i + 1
End With
Next olApt
Set olApt = Nothing
Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
|
评分
-
1
查看全部评分
-
|