如何找到订阅的 Internet 日历的文件夹路径？

Question

我正在尝试列出从 gmail 订阅的 Internet 日历的事件。

代码仅列出在日历文件夹中的 Outlook 应用中创建的事件。

这是我在 Stack Overflow 上找到的代码：

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/2018")
ToDate = CDate("12/31/2019")

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 9
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

我几乎肯定问题出在这里：

Set olFolder = olNS.GetDefaultFolder(9) 'olFolderCalendar 9

我要访问的文件夹的名称是基本的。这两个我都试过了：

Set olFolder = olNS.GetDefaultFolder(9).Folders("basic").Items
Set olFolder = olNS.GetDefaultFolder(9).Parent.Folders("basic").Items

都没有用。

运行时错误“-2147221233 (8004010f)”：
尝试的操作失败。找不到对象。

这是我要从中获取事件的基本文件夹。

编辑：
我最终发现：olNS.GetDefaultFolder(9).Parent = email@gmail.com 和它的孩子是我在图片中看到的日历“日历”之一。 “基本”日历的父级是 Internet 日历。如何将 olFolder 设置为目录 '\Internet Calendars\basic' 而不是 '\email@gmail.com\Calendar'？

Answer 1

我发现它就像将 olFolder 设置为父文件夹和子文件夹一样简单，

设置 olFolder = olNS.Folders("互联网日历").Folders("日历")

Answer 2

我找到了一小段代码来确定你所有的文件夹和子文件夹。

    Sub List_All_NameSpace_Folders()
       Dim myNS As Outlook.Namespace
       Dim myFolder As MAPIFolder
       Dim mySubfolder As MAPIFolder
       enter code hereDim nextrow As Long
       Dim nextrows As Long

Set myNS = Outlook.Application.GetNamespace("MAPI")
With myNS
    For Each myFolder In myNS.Folders
        With Sheets("blad1")
            nextrows = .Cells(Rows.Count, 2).End(xlUp).Offset(1).Row
            .Cells(nextrows, 1).Value = myFolder.Name
                For Each mySubfolder In myFolder.Folders
                    nextrow = .Cells(Rows.Count, 2).End(xlUp).Offset(1).Row
                    .Cells(nextrow, 2).Value = mySubfolder.Name
                Next mySubfolder
        End With
    Next myFolder
End With
End Sub

工作表上的 A 列包含所有“myFolder”名称

工作表上的 B 列包含所有“mySubfolder”名称

设置 olFolder = olNS.Folders("myFolder").Folders("mySubfolder")

enter code here
Sub ListAppointments()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olFolder2 As Outlook.MAPIFolder
Dim olApt As Outlook.AppointmentItem
Dim nextrow As Long
Dim FromDate As Date
Dim ToDate As Date


FromDate = CDate("10/01/2019")
ToDate = CDate("12/31/2019")

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.Folders("internetagenda's").Folders("bis")


With Sheets("blad1")
nextrow = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row


 'Change the name of the sheet here
.Range("A1:D1").Value = Array("NAAM", "DATUM", "DUUR", "BIJZONDERHEDEN")
   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, "B").NumberFormat = "D MMMM YYYY"
        .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 = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
       Else
       End If
   Next olApt
    .Columns.AutoFit
 End With

 Set olApt = Nothing
 Set olFolder = Nothing
 Set olNs = Nothing
 Set olApp = Nothing

 End Sub

希望对大家有所帮助