How to locate a subscribed internet calendar's folder path?

Question

I am trying to list the events of a subscribed internet calendar from gmail.

The code only lists events created in the Outlook app in the Calender Folder.

Here is the code I found on 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

I am almost positive that the issue lies here:

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

The name of the folder I want to access is basic. I tried both of these:

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

None worked.

Run-time error '-2147221233 (8004010f)':
The Attempted operation failed. An Object Could Not Be Found.

Here is the basic folder I want to grab the events from.

EDIT:
I ultimately found: olNS.GetDefaultFolder(9).Parent = email@gmail.com and its child is one of my calendars "Calendar" seen in the picture. The parent of "basic" calendar is Internet Calendars. How can I set olFolder to the directory '\Internet Calendars\basic' instead of '\email@gmail.com\Calendar'?

"none of these worked" does not convey usable information. State what happens for each of the two tries. — niton, Mar 06 '19 at 19:17
Right. Run-time error '-2147221233 (8004010f)': The Attempted operation failed. An Object Could Not Be Found. — David Podolak, Mar 06 '19 at 19:32
In the original code the object olFolder is an Outlook folder. `Set olFolder = olNS.GetDefaultFolder(9)`. You prematurely bring in Items in `Set olFolder = olNS.GetDefaultFolder(9).Parent.Folders("basic").Items`. Drop .Items — niton, Mar 06 '19 at 19:42
Modify this to look at the calendars under olNS.GetDefaultFolder(9).Parent. https://stackoverflow.com/questions/33655041/vba-code-to-loop-through-every-folder-and-subfolder-in-outlook — niton, Mar 06 '19 at 20:10
Okay, so this is what I ultimately found: olNS.GetDefaultFolder(9).Parent = email@gmail.com and Its Child is one of my calendars "Calendar" seen in the picture. The parent of "basic" calendar is Internet Calendars. How can I set olFolder to the directory '\\Internet Calendars\basic' instead of '\\email@gmail.com\Calendar' — David Podolak, Mar 06 '19 at 21:25

score 0 · Accepted Answer · answered Mar 08 '19 at 15:40

0

I figured it out it was as simple as Setting olFolder to the parent folder and child folder,

Set olFolder = olNS.Folders("Internet Calendars").Folders("Calend")

answered Mar 08 '19 at 15:40

David Podolak

195
2
10

score -1 · Answer 2 · answered Nov 07 '19 at 23:21

i found a small piece of code to determine all your folders and subfolders.

    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

column A on the sheet contains all "myFolder"names

column B on the sheet contains all "mySubfolder"names

Set 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

i hope this will help people

How to locate a subscribed internet calendar's folder path?

2 Answers2