Project VBA
2 TopicsAdding 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!2.3KViews0likes6CommentsSending 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! Thanks1.1KViews0likes0Comments