crackwood01
New Member
- Joined
- Mar 16, 2016
- Messages
- 43
***OUTLOOK CALENDARS
Hi
Here is my code so far, what am i missing?
Hi
Here is my code so far, what am i missing?
VBA Code:
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