创建约会（从MS Project）到非默认的Outlook日历 [英] Create an appointment (from MS Project) to a non-default outlook calendar
问题描述
您好，
< span style ="font-family：Verdana">我正在研究一些VBA宏，它们将Microsoft Project Task的数据导出到一个新的约会中（在outlook日历上）。
它会向添加的收件人发送约会，并将其作为整理器保存在用户的日历上。
有些用户愿意l将许多任务导出为约会，但他们不希望它填写默认日历。
所以我试图找到一种方法将其添加到非默认值日历。
我在"我的日历"下方添加了日历名称"MSP" ;文件夹。
（我正在使用Outlook 2016，但如果重要的话，公司的一些用户正在使用Outlook 2010）
我尝试了几种方法来查找日历并将会议添加到其中但它始终将其置于默认值。
下面我正在添加VBA代码，没有我尝试过的，如果你可以帮我找到或建议我应该添加什么或用什么代码行来在第二个日历上使用它，我们将非常感激。
基本上我需要的是： < br style ="color：＃333333; FONT-FAMILY：宋体，宋体，宋体，宋体，日内瓦，无衬线;字体大小：13像素;行高：正常; background-color：#fafafa">
- 检查用户是否有另一个名为"MSP"的日历，如果没有，请创建它。
- 一旦用户拥有该日历，就应该将约会添加到"MSP"日历中。
Ofir Marco，MCTS PZ项目 您好， 我正在处理一些导出Microsoft Project Task的VBA宏数据进入新的约会（在展望日历上）。 它向添加的收件人发送约会，并将其作为组织者保存在用户的日历上。 有些用户会将很多任务导出为约会，但他们不希望它填写默认日历。 所以我试图找到一种方法将其添加到非默认日历。 我添加了日历名称"MSP"。下面的"我的日历"夹。 我尝试了一些方法来查找日历并将会议添加到其中但是它始终将其置于默认值。 下面我正在添加VBA代码，没有我尝试过的，如果你可以帮我找到或建议我应该添加什么或者使用什么代码行来实现它第二个日历非常感谢。 基本上我需要的是： 请忽略Call ReplaceAppointments行，如果日期已更改，则调用覆盖现有约会的程序。 您也可以忽略反映MS Project更改的代码行，只需考虑Outlook行。 我的代码：&NBSP; &NBSP; &NBSP; &NBSP; Sub Export_Selection_To_Resources_OL_Calendar_Appointments_From_Other_Account（） 下一页myTask
请忽略Call ReplaceAppointments行，它调用的程序覆盖了如果日期已更改，则现有预约。
您也可以忽略反映MS Project更改的代码行，注意前景线。
我的代码：
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
设置myOLApp = CreateObject（" Outlook.Application"）
设置Ns = Application.GetNamespace（" MAPI"）
¥ b $ b For Each myTask在ActiveSelection.Tasks
设置myItem = myOLApp.CreateItem（olAppointmentItem）
使用myItem
'替换现有约会
调用ReplaceAppointments（myTask.OutlineParent.OutlineParent.Na我和我" >> " &安培; myTask.OutlineParent.Name& " >> " &安培; myTask.Name& " （项目任务）"）
.Start = myTask.Start
.End = myTask.Finish
.Subject = myTask.OutlineParent.OutlineParent.Name& " >> " &安培; myTask.OutlineParent.Name& " >> " &安培; myTask.Name& " （项目任务）"
$
.Categories =" Exported" b
.Body = myTask.Notes
.BusyStatus = olFree
.Location =" TBD"
'.Recipients.Add（myTask.ResourceNames）
.OptionalAttendees = Replace（myTask.ResourceNames，"， "，";"）
。保存
。会员状态= 1
.ResponseRequested = True
。移动myDestFolder
。发送
结束与
如果不（myTask Is Nothing）然后
myTask.Date1 = myTask.Start
myTask.Date2 = myTask.Finish
myTask.Text25 =" ;约会< b $ b结束如果
下一个myTask
x = MsgBox（"所有选定的任务导出到资源Outlo ok日历作为约会"，vbOKOnly，" Export Completed"）= vbOK
Application.Calculation = pjAutomatic
Application.ScreenUpdating = True
结束次
（我使用的是Outlook 2016，但如果重要的话，公司的一些用户正在使用outlook 2010）
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 .Fold
Application.Calculation = pjManual
Application.ScreenUpdating = False
On Error Resume Next
设置myOLApp = CreateObject（" Outlook.Application"）
设置Ns = Application.GetNamespace（" MAPI"）
每个myTask在ActiveSelection.Tasks中使用
设置myItem = myOLApp.CreateItem（olAppointmentItem）
使用myItem
'替换现有的预约
调用ReplaceAppointments（myTask.OutlineParent.OutlineParent.Name&">>"& myTask.OutlineParent.Name&">>"& myTask.Name&"（Project Task） "）
&NBSP; &NBSP; .Start = myTask.Start
&NBSP; &NBSP; .End = myTask.Finish
&NBSP; &NBSP; .Subject = myTask.OutlineParent.OutlineParent.Name& " >> " &安培; myTask.OutlineParent.Name& " >> " &安培; myTask.Name& " （项目任务）" b
&NBSP; &NBSP; .Categories =" Exported"
&NBSP; &NBSP; .Body = myTask.Notes
&NBSP; &NBSP; .BusyStatus = olFree
&NBSP; &NBSP; .Location =" TBD"
&NBSP; ' .Recipients.Add（myTask.ResourceNames）
&NBSP; &NBSP; .OptionalAttendees = Replace（myTask.ResourceNames，"，"，";"）
&NBSP; &NBSP; 。保存¥b $ b &NBSP; &NBSP; .MeetingStatus = 1
&NBSP; &NBSP; .ResponseRequested = True
。移动myDestFolder
&NBSP; 。发送
结束与$
&NBSP;如果不是（myTask Is Nothing）则为
&NBSP; &NBSP; &NBSP; myTask.Date1 = myTask.Start
&NBSP; &NBSP; &NBSP; myTask.Date2 = myTask.Finish
&NBSP; &NBSP; &NBSP; myTask.Text25 ="约会"
&NBSP;结束如果
&NBSP; x = MsgBox（"导出到资源的所有选定任务Outlook日历作为约会"，vbOKOnly，"导出已完成"）= vbOK
Application.Calculation = pjAutomatic
Application.ScreenUpdating = True
End Sub
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)
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
Ofir Marco , MCTS P.Z. Projects
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)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 IfNext 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
这篇关于创建约会（从MS Project）到非默认的Outlook日历的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
