定期会议

hxhgxy

如何预约每个月的第10个工作日的会议？

Outlook 2000 中只有第一到四，已经最后一天的选项，真不方便！

另外，象会议的重复周期的对话框是无法设计的。。。

aaaaabbbbb

有可能用VBA是可以实现的,Weekday的函数可以判断周几.

hxhgxy

值	定期类型	属性	示例
0	olRecursDaily	Interval	每 N 天
		DayOfWeekMask	每星期二、星期三以及星期四
2	olRecursMonthly	Interval	每 N 个月
		DayOfMonth	某月的第 N 天
3	olRecursMonthNth	Interval	每 N 个月
		Instance	第 N 个星期二
		DayOfWeekMask	每星期二和星期三
1	olRecursWeekly	Interval	每 N 周
		DayOfWeekMask	每星期二、星期三和星期四
5	olRecursYearly	DayOfMonth	某月的第 N 天
		MonthOfYear	二月
6	olRecursYearNth	Instance	第 N 个星期二
		DayOfWeekMask	星期二、星期三、星期四
		MonthOfYear	二月

这是帮助里的重复周期模式，估计要随意按工作日来定义很难啊。ab兄帮忙研究一下吧！

aaaaabbbbb

试一下下面代码,我在2007下测试总是不令人满意,逐语句过的时候可以将每月第10个工作日显示出来,但直接执行又只看到第12月份的,你在2003下试一下.

Sub Appointment()
'Creates an appointment in a year for each month on the 10th working day
    Dim appolApp As Outlook.Application
    Dim olApptItem As Outlook.AppointmentItem
    'Creates an instance of the application
    Set appolApp = Outlook.Application
    'Creates appointment item
    Set olApptItem = appolApp.CreateItem(olAppointmentItem)
    j = 1
    With olApptItem
       For i = 8 To 12
        Do Until j = 10
            If Weekday(DateSerial(2007, i, j + k), vbMonday) = 6 Or Weekday(DateSerial(2007, i, j + k), vbMonday) = 7 Then
               k = k + 1
            Else
               j = j + 1
            End If
        Loop
            .Start = DateSerial(2007, i, j + k) + TimeValue("10:00:00")
            .End = .Start + TimeValue("01:00:00")
            .Body = "Please meet with me regarding important issue
            .Recipients.Add ("Alan")
            .Subject = "Meeting with Alan"
            'Display the appointment
            .Display '这句是显示,如果不需要可注释掉
         '   .Send  '这句是发送,被我注释掉
            .Save
            k = 0
            j = 1
       Next
   End With
  
   Set olApptItem = Nothing
   Set appolApp = Nothing
End Sub

[此贴子已经被作者于2007-8-5 23:27:20编辑过]

hxhgxy

我用的是倒霉的2000版，明天试试。谢谢先！

Long_III

下面代码测试通过，XP＋2003

Sub Appointment()
'Creates an appointment in a year for each month on the 10th working day
    Dim appolApp As Outlook.Application
    Dim olApptItem As Outlook.AppointmentItem
    'Creates an instance of the application
    Set appolApp = Outlook.Application
    'Creates appointment item

    j = 1
    For i = 8 To 12
        Set olApptItem = appolApp.CreateItem(olAppointmentItem)
        With olApptItem
            Do Until j = 10
                If Weekday(DateSerial(2008, i, j + k), vbMonday) = 6 Or Weekday(DateSerial(2008, i, j + k), vbMonday) = 7 Then
                    k = k + 1
                Else
                    j = j + 1
                End If
            Loop
            .Start = DateSerial(2008, i, j + k) + TimeValue("10:00:00")
            .End = .Start + TimeValue("01:00:00")
            .Body = "Please meet with me regarding important issue"
            .Recipients.Add ("Alan")
            .Subject = "Meeting with Alan"
            'Display the appointment
            '.Display '这句是显示,如果不需要可注释掉
            '   .Send  '这句是发送,被我注释掉
            .Save
            k = 0
            j = 1
        End With
        Set olApptItem = Nothing
    Next

    Set appolApp = Nothing
End Sub

随便弄了个删除的，

Sub Del_Appointment()
'Creates an appointment in a year for each month on the 10th working day
    Dim appolApp As Outlook.Application
    Dim Myns As NameSpace
    Dim olApptItem As Outlook.AppointmentItem
    'Creates an instance of the application
    Set appolApp = Outlook.Application
    Set Myns = appolApp.GetNamespace("MAPI")
   
    For Each olApptItem In Myns.GetDefaultFolder(olFolderCalendar).Items
        'Debug.Print olApptItem.Subject
        If olApptItem.Subject = "Meeting with Alan" Then olApptItem.Delete
    Next

    Set appolApp = Nothing
    Set Myns = Nothing
End Sub

[此贴子已经被作者于2008-8-5 9:52:45编辑过]