crackwood01
New Member
- Joined
- Mar 16, 2016
- Messages
- 43
Hi everyone,
i wrote a vba code to export Microsoft project tasks as Outlook Calendar Appointments
For my needs, it's enough .. but i would like to create a userform to select the destination calendar from a userform combobox
With this code found here i'm able to pull a complete list of calendars, but how can i populate a combobox with it??
i wrote a vba code to export Microsoft project tasks as Outlook Calendar Appointments
VBA Code:
Sub ExportToOutlook()
Dim ol As Outlook.Application
Dim olAp As Outlook.AppointmentItem
Dim proj As Project
Dim t As Task
Dim pj As Project
Set pj = ActiveProject
For Each t In pj.Tasks
Set ol = New Outlook.Application
Set olAp = ol.CreateItem(olAppointmentItem)
With olAp
.Subject = t.Name
.Start = t.Start
.End = t.Finish
.Save
End With
Next t
End Sub
For my needs, it's enough .. but i would like to create a userform to select the destination calendar from a userform combobox
With this code found here i'm able to pull a complete list of calendars, but how can i populate a combobox with it??
Code:
Sub IterateAllCalendars()
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
s = ""
Set objOL = 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
For Each objNavFolder In objNavGroup.NavigationFolders
On Error Resume Next
Set objFolder = objNavFolder.Folder
If Err = 0 Then
s = s & objNavGroup.Name & " -- " & objNavFolder.DisplayName & vbCrLf
Else
s = s & objNavGroup.Name & " -- " & objNavFolder.DisplayName & vbCrLf
End If
On Error GoTo 0
Next
Next
Set objOL = Nothing
Set objNS = Nothing
Set objNavMod = Nothing
Set objNavGroup = Nothing
Set objNavFolder = Nothing
Set objFolder = Nothing
Set colExpl = Nothing
MsgBox s
End Sub