請問一下VBA可以抓特定日期範圍的OUTLOOK行事曆回來嗎?

帖子: 11
主題: 2
精華: 0
積分: 60
點名: 79
作業系統: WIN7
軟體版本: SP2
閱讀權限: 20
註冊時間: 2016-8-30
最後登錄: 2024-11-15

2022虎年全勤獎章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2021-3-15 14:06 | 只看該作者

請問一下VBA可以抓特定日期範圍的OUTLOOK行事曆回來嗎?

POWERQUERY取資料速度比較慢，範圍也很大
不曉得VBA能不能直接存取?

帖子: 11
主題: 2
精華: 0
積分: 60
點名: 79
作業系統: WIN7
軟體版本: SP2
閱讀權限: 20
註冊時間: 2016-8-30
最後登錄: 2024-11-15

2022虎年全勤獎章

2^#

發表於 2021-3-15 22:41 | 只看該作者

https://www.mrexcel.com/board/threads/outlook-calendar-vba.816885/

有找到這個範例，可是它抓到"行事曆"，我想抓的是"共用行事曆"
請問要修改那裡？

帖子: 11
主題: 2
精華: 0
積分: 60
點名: 79
作業系統: WIN7
軟體版本: SP2
閱讀權限: 20
註冊時間: 2016-8-30
最後登錄: 2024-11-15

2022虎年全勤獎章

3^#

發表於 2021-3-16 14:00 | 只看該作者

我己經抓到想要的行事曆了~~

帖子: 11
主題: 2
精華: 0
積分: 60
點名: 79
作業系統: WIN7
軟體版本: SP2
閱讀權限: 20
註冊時間: 2016-8-30
最後登錄: 2024-11-15

2022虎年全勤獎章

4^#

發表於 2021-3-16 14:50 | 只看該作者

Public Sub ListAppointments()
On Error GoTo ErrHand:
Application.ScreenUpdating = False
'This is an enumeration value in context of getDefaultSharedFolder
Const olFolderCalendar As Byte = 9
Dim olApp As Object: Set olApp = CreateObject("Outlook.Application")
Dim olNS As Object: Set olNS = olApp.GetNamespace("MAPI")
Dim olFolder As Object
Dim olApt As Object
Dim objOwner As Object: Set objOwner = olNS.CreateRecipient("自己的EMAIL")
Dim NextRow As Long
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim FromDate As Date
Dim ToDate As Date
objOwner.Resolve
If objOwner.Resolved Then
Set olFolder = olNS.GetSharedDefaultFolder(objOwner, olFolderCalendar).Folders("共用行事曆")
End If
ws.Range("A1:D1").Value2 = Array("Subject", "Start", "End", "Location")
'Ensure there at least 1 item to continue
If olFolder.Items.Count = 0 Then Exit Sub
'Create an array large enough to hold all records
Dim myArr() As Variant: ReDim myArr(0 To 3, 0 To olFolder.Items.Count - 1)
'Add the records to an array
'Add this error skip, as I found some of my calendar items don't have all properties e.g. a start time
On Error Resume Next
FromDate = InputBox("Enter the start date (format: yyyy/mm/dd)")
ToDate = InputBox("Enter the end date(format: yyyy/mm/dd)")
For Each olApt In olFolder.Items
If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
myArr(0, NextRow) = olApt.Subject
myArr(1, NextRow) = olApt.Start
myArr(2, NextRow) = olApt.End
myArr(3, NextRow) = olApt.Categories
NextRow = NextRow + 1
Else
End If
Next
On Error GoTo 0
'Write all records to a worksheet from an array, this is much faster
ws.Range("A2:D" & NextRow + 1).Value = WorksheetFunction.Transpose(myArr)
'AutoFit
ws.Columns.AutoFit
cleanExit:
Application.ScreenUpdating = True
Exit Sub
ErrHand:
'Add error handler
Resume cleanExit
End Sub

複製代碼

以上這樣就能取出共用行事曆裡的資料

帖子: 11
主題: 2
精華: 0
積分: 60
點名: 79
作業系統: WIN7
軟體版本: SP2
閱讀權限: 20
註冊時間: 2016-8-30
最後登錄: 2024-11-15

2022虎年全勤獎章

5^#

發表於 2021-3-17 12:03 | 只看該作者

請問一下myArr(4, NextRow) = 要增加一個AllDayEvent要怎麼寫?
剛發現全天事件的結束日期會多了一天出來，想抓全天事件回來再改寫
可是不會寫