OfirMarco
07-26-2017, 11:49 PM
Hello,
I am working on some VBA macros that exports Microsoft Project Task's data into a new appointment (on outlook calendar).
It sends an appointment to the added recipients and keeps it on the user's calendar as the organizer.
Some users will export a lot of tasks as appointments but they will not want it to fill in their default calendar.
So i am trying to find a way to add it to a non default calendar.
i have added a calendar names "MSP" below "My calendars" folder.
(i am using outlook 2016 but some of the users in the company are using outlook 2010 if it matters)
https://social.technet.microsoft.com/Forums/getfile/1103153
i tried a few methods to locate the calendar and add the meeting into it but it always places it in the default one.
Below i am adding the VBA code, without what i have tried, if you can help me find or suggest what i should add or what code lines to use to have it on the second calendar it would be very appreciated.
Basically what i need is:
Check if the user has another calendar named "MSP" if not, create it.
once the user has that calendar it should add the appointment to the "MSP" calendar.
Please ignore the Call ReplaceAppointments line, it is calling a procedure that overrides an existing appointment if dates were changed.
You can also ignore the code lines that are reflecting MS Project changes, just mind the outlook lines.
My Code:
Sub Export_Selection_To_Resources_OL_Calendar_Appointments_From_Other_Account()
Dim myOLApp As Outlook.Application
Dim myTask As Task
Dim myItem As Outlook.AppointmentItem
Dim x As Integer
Dim oAccount As Outlook.Account
Dim Ns As Outlook.NameSpace
Dim myDestFolder As Outlook.Folder
Application.Calculation = pjManual
Application.ScreenUpdating = False
On Error Resume Next
Set myOLApp = CreateObject("Outlook.Application")
Set Ns = Application.GetNamespace("MAPI")
For Each myTask In ActiveSelection.Tasks
Set myItem = myOLApp.CreateItem(olAppointmentItem)
With myItem
' Replace existing appointment
Call ReplaceAppointments(myTask.OutlineParent.OutlineParent.Name & " >> " & myTask.OutlineParent.Name & " >> " & myTask.Name & " (Project Task)")
.Start = myTask.Start
.End = myTask.Finish
.Subject = myTask.OutlineParent.OutlineParent.Name & " >> " & myTask.OutlineParent.Name & " >> " & myTask.Name & " (Project Task)"
.Categories = "Exported"
.Body = myTask.Notes
.BusyStatus = olFree
.Location = "TBD"
' .Recipients.Add (myTask.ResourceNames)
.OptionalAttendees = Replace(myTask.ResourceNames, ",", ";")
.Save
.MeetingStatus = 1
.ResponseRequested = True
.Move myDestFolder
.Send
End With
If Not (myTask Is Nothing) Then
myTask.Date1 = myTask.Start
myTask.Date2 = myTask.Finish
myTask.Text25 = "Appointment"
End If
Next myTask
x = MsgBox("All selected tasks exported to resources Outlook Calendar as appointments", vbOKOnly, "Export Completed") = vbOK
Application.Calculation = pjAutomatic
Application.ScreenUpdating = True
End Sub
I am working on some VBA macros that exports Microsoft Project Task's data into a new appointment (on outlook calendar).
It sends an appointment to the added recipients and keeps it on the user's calendar as the organizer.
Some users will export a lot of tasks as appointments but they will not want it to fill in their default calendar.
So i am trying to find a way to add it to a non default calendar.
i have added a calendar names "MSP" below "My calendars" folder.
(i am using outlook 2016 but some of the users in the company are using outlook 2010 if it matters)
https://social.technet.microsoft.com/Forums/getfile/1103153
i tried a few methods to locate the calendar and add the meeting into it but it always places it in the default one.
Below i am adding the VBA code, without what i have tried, if you can help me find or suggest what i should add or what code lines to use to have it on the second calendar it would be very appreciated.
Basically what i need is:
Check if the user has another calendar named "MSP" if not, create it.
once the user has that calendar it should add the appointment to the "MSP" calendar.
Please ignore the Call ReplaceAppointments line, it is calling a procedure that overrides an existing appointment if dates were changed.
You can also ignore the code lines that are reflecting MS Project changes, just mind the outlook lines.
My Code:
Sub Export_Selection_To_Resources_OL_Calendar_Appointments_From_Other_Account()
Dim myOLApp As Outlook.Application
Dim myTask As Task
Dim myItem As Outlook.AppointmentItem
Dim x As Integer
Dim oAccount As Outlook.Account
Dim Ns As Outlook.NameSpace
Dim myDestFolder As Outlook.Folder
Application.Calculation = pjManual
Application.ScreenUpdating = False
On Error Resume Next
Set myOLApp = CreateObject("Outlook.Application")
Set Ns = Application.GetNamespace("MAPI")
For Each myTask In ActiveSelection.Tasks
Set myItem = myOLApp.CreateItem(olAppointmentItem)
With myItem
' Replace existing appointment
Call ReplaceAppointments(myTask.OutlineParent.OutlineParent.Name & " >> " & myTask.OutlineParent.Name & " >> " & myTask.Name & " (Project Task)")
.Start = myTask.Start
.End = myTask.Finish
.Subject = myTask.OutlineParent.OutlineParent.Name & " >> " & myTask.OutlineParent.Name & " >> " & myTask.Name & " (Project Task)"
.Categories = "Exported"
.Body = myTask.Notes
.BusyStatus = olFree
.Location = "TBD"
' .Recipients.Add (myTask.ResourceNames)
.OptionalAttendees = Replace(myTask.ResourceNames, ",", ";")
.Save
.MeetingStatus = 1
.ResponseRequested = True
.Move myDestFolder
.Send
End With
If Not (myTask Is Nothing) Then
myTask.Date1 = myTask.Start
myTask.Date2 = myTask.Finish
myTask.Text25 = "Appointment"
End If
Next myTask
x = MsgBox("All selected tasks exported to resources Outlook Calendar as appointments", vbOKOnly, "Export Completed") = vbOK
Application.Calculation = pjAutomatic
Application.ScreenUpdating = True
End Sub