Pull a list of Excel Calendars Name to Populate a Userform Combobox

[crackwood01]

***OUTLOOK CALENDARS

Hi

Here is my code so far, what am i missing?

Sub Calendars(ByRef zCalendars() As String)
Dim s As String
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim objExpCal As Outlook.Explorer
    Dim objNavMod As Outlook.CalendarModule
    Dim objNavGroup As Outlook.NavigationGroup
    Dim objNavFolder As Outlook.NavigationFolder
    Dim objFolder As Outlook.Folder
    Dim colExpl As Outlook.Explorers


 ReDim zCalendars(0)
 Dim lNb As Long

s = ""
Set objOL = Outlook.Application
    Set objNS = objOL.Session
    Set colExpl = objOL.Explorers
    Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
    Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)

      For Each objNavGroup In objNavMod.NavigationGroups
     
        ReDim Preserve zCalendars(lNb)
       
        On Error Resume Next
        Set objFolder = objNavFolder.Folder
        If Err = 0 Then
               
        zCalendars(lNb) = s & objNavFolder.DisplayName & vbCrLf
        lNb = lNb + 1
       
         Else
                zCalendars(lNb) = s & objNavFolder.DisplayName & vbCrLf
        lNb = lNb + 1
            End If
            On Error GoTo 0
        'olstrOutput = olstrOutput & olobjCategory.Name & vbCrLf
     Next

 'MsgBox olstrOutput
    Set objOL = Nothing
    Set objNS = Nothing
    Set objNavMod = Nothing
    Set objNavGroup = Nothing
    Set objNavFolder = Nothing
    Set objFolder = Nothing
    Set colExpl = Nothing
 End Sub

Private Sub UserForm_Initialize()
    Dim aCalendars() As String
    Dim i As Long

    Calendars aCalendars()

    Me.ComboBox1.List = aCalendars()

End Sub

 

[crackwood01]

**Oulook Calendars