Sending MS Project task to Outlook as an appointment in a custom calendar
I came across this macro which is working fine thus far. What it does is that it sends a task in MS Project to MS Outlook as a new appointment to add to my Outlook calendar. Sub Export_Selection_To_OL_Appointments() Dim myTask As Task Dim myItem As Object On Error Resume Next Set myOLApp = CreateObject("Outlook.Application") For Each myTask In ActiveSelection.Tasks Set myItem = myOLApp.CreateItem(1) With myItem .Start = myTask.Start .End = myTask.Finish .Subject = " Rangebank PS " & myTask.Name .Categories = myTask.Project .Body = myTask.Notes .Save End With Next myTask End Sub The code currently creates an appointment in my default Calendar but I wanted for it to create an appointment within a different calendar with a different name. I sought help else where and was provided this as a way to reference a non default calendar, which is below Option Explicit Sub NonDefaultFolder_Add_Not_Create() Dim myOlApp As Object Dim myDefaultStore As Object Dim nonDefaultCalendar As Object Dim myItem As Object On Error Resume Next Set myOlApp = CreateObject("Outlook.Application") ' Consider this mandatory. ' Limit the scope of the error bypass to the minimum number of lines. ' Ideally the scope is zero lines. On Error GoTo 0 If Not myOlApp Is Nothing Then Set myDefaultStore = myOlApp.Session.defaultStore Debug.Print myDefaultStore ' This references a calendar on the same level as the default calendar Set nonDefaultCalendar = myOlApp.Session.Folders(myDefaultStore.DisplayName).Folders("Calendar Name") nonDefaultCalendar.Display ' Add to non-default folders (or create in the default then copy or move) Set myItem = nonDefaultCalendar.Items.Add With myItem .Subject = " Rangebank PS " .Display End With Else MsgBox "Error creating Outlook object." End If End Sub I am very much a novice and wassnt sure where I was supposed to add the above into the original code so I tried this. Option Explicit Sub NonDefaultFolder_Add_Not_Create() Dim myTask As Task Dim myItem As Object Dim myOLApp As Object Dim myDefaultStore As Object Dim nonDefaultCalendar As Object On Error Resume Next Set myOLApp = CreateObject("Outlook.Application") For Each myTask In ActiveSelection.Tasks Set myItem = myOLApp.CreateItem(1) With myItem .Start = myTask.Start .End = myTask.Finish .Subject = " Rangebank PS " & myTask.Name .Categories = myTask.Project .Body = myTask.Notes .Save On Error GoTo 0 If Not myOLApp Is Nothing Then Set myDefaultStore = myOLApp.Session.DefaultStore Debug.Print myDefaultStore Set nonDefaultCalendar = myOLApp.Session.Folders(myDefaultStore.DisplayName).Folders("B2A Projects Calendar") nonDefaultCalendar.Display ' Add to non-default folders (or create in the default then copy or move) Set myItem = nonDefaultCalendar.Items.Add With myItem .Subject = " Rangebank PS " .Display End If End With End Sub Unfortunately I get this error "Run-time error '-2147221233 (8004010f)': The attempted operation failed. An Object could not be found. It highlights this as the error Set nonDefaultCalendar = myOLApp.Session.Folders(myDefaultStore.DisplayName).Folders("B2A Projects Calendar") If it helps this is where the B2A project Calendar appears in outlook calendr.jpg So its a calendar I created and then I share it with my other team members. Any help would be greatly appreciated! ThanksAdding a ComboBox to a MS Project Ribbon
Currently, I am using Project 2019. I created a custom ribbon using VBA code that creates an XML string and is activated using the following code: ActiveProject.SetCustomUI (ribbonXml) I tried to add a ComboBox to the ribbon using the following code: ribbonXml = ribbonXml + " <mso:group id=""grpLabel"" label=""Quick Labels"" autoScale=""true"">" ribbonXml = ribbonXml + " <comboBox id=""cboLabels"" label=""Labels"" onChange=""TestRibbon"">" ribbonXml = ribbonXml + " <item id=""lblAdd"" label=""Add"" />" ribbonXml = ribbonXml + " <item id=""lblDel"" label=""Delete"" />" ribbonXml = ribbonXml + " <item id=""lblChg"" label=""Change"" />" ribbonXml = ribbonXml + " </comboBox>" ribbonXml = ribbonXml + " </mso:group>" The ribbon works fine before adding this code. Once this code is added, the ribbon fails to load. I thought adding the onAction property was causing this but that did not change anything. The code above was just to get the combo box to appear. I would add the rest of the properties later. What am I doing wrong? Is Microsoft going to do anything to make this easier? Creating custom UIs should not be this hard to do. Thank you in advance!