請問一下VBA可以抓特定日期範圍的OUTLOOK行事曆回來嗎?
- 帖子
- 12
- 主題
- 2
- 精華
- 0
- 積分
- 61
- 點名
- 12
- 作業系統
- WIN7
- 軟體版本
- SP2
- 閱讀權限
- 20
- 註冊時間
- 2016-8-30
- 最後登錄
- 2026-7-11
|
請問一下VBA可以抓特定日期範圍的OUTLOOK行事曆回來嗎?
POWERQUERY取資料速度比較慢，範圍也很大
不曉得VBA能不能直接存取? |
|
|
|
|
|
|
|
- 帖子
- 12
- 主題
- 2
- 精華
- 0
- 積分
- 61
- 點名
- 12
- 作業系統
- WIN7
- 軟體版本
- SP2
- 閱讀權限
- 20
- 註冊時間
- 2016-8-30
- 最後登錄
- 2026-7-11
|
2#
發表於 2021-3-15 22:41
| 只看該作者
https://www.mrexcel.com/board/threads/outlook-calendar-vba.816885/
有找到這個範例，可是它抓到"行事曆"，我想抓的是"共用行事曆"
請問要修改那裡？ |
|
|
|
|
|
|
|
- 帖子
- 12
- 主題
- 2
- 精華
- 0
- 積分
- 61
- 點名
- 12
- 作業系統
- WIN7
- 軟體版本
- SP2
- 閱讀權限
- 20
- 註冊時間
- 2016-8-30
- 最後登錄
- 2026-7-11
|
3#
發表於 2021-3-16 14:00
| 只看該作者
|
|
|
|
|
|
|
- 帖子
- 12
- 主題
- 2
- 精華
- 0
- 積分
- 61
- 點名
- 12
- 作業系統
- WIN7
- 軟體版本
- SP2
- 閱讀權限
- 20
- 註冊時間
- 2016-8-30
- 最後登錄
- 2026-7-11
|
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
以上這樣就能取出共用行事曆裡的資料 |
|
|
|
|
|
|
|
- 帖子
- 12
- 主題
- 2
- 精華
- 0
- 積分
- 61
- 點名
- 12
- 作業系統
- WIN7
- 軟體版本
- SP2
- 閱讀權限
- 20
- 註冊時間
- 2016-8-30
- 最後登錄
- 2026-7-11
|
5#
發表於 2021-3-17 12:03
| 只看該作者
請問一下myArr(4, NextRow) = 要增加一個AllDayEvent要怎麼寫?
剛發現全天事件的結束日期會多了一天出來，想抓全天事件回來再改寫
可是不會寫 |
|
|
|
|
|
|
|
