VBA实现EXCEL计划导入OUTLOOK日历

jonn

本人习惯用excel来做周计划和月计划，考虑导入OUTLOOK的日历中增加提醒功能。如果用outlook的文件导入功能十分复杂。现提出以下需求，请各位宏高手帮忙。谢谢。
要求陈述：用VBA宏实现将excel的工作计划表中内容自动转到OUTLOOK中，并实现提醒功能。
附件工作薄中有PLAN和CLANDAR两个工作表，具体要求细节如下：
1）主题，开始日期、结束日期要相互对应，
2）均设定为全天事件，
3）提醒开关要打开，
4）会议组织者是对应PLAN表中的负责人。
5）另外如果outlook中已经有类似的日历安排，则覆盖原日历安排。
类似日历判断条件：主题内容完全一样。

OUTLOOK日历表格格式见“CALENDAR”工作表。

[ 本帖最后由 jonn 于 2010-6-13 17:29 编辑 ]

xinjiana

这个你直接用project好了，干嘛用excel啊
这个比较麻烦，建议你自己录制宏，慢慢研究吧

yanjie

好问题！顶一下！

jonn

回xinjiana，project曾用过一段时间，功能很强大但我不熟悉，学习起来要耗费时间，而且打印输出是一个问题，后来放弃啦。
感谢yanjie版主的题目加分，也希望更多的EXCEL宏高手来参与这个题目。当然可能会影响到大家看世界杯，呵呵。

xinjiana

原帖由 jonn 于 2010-6-13 08:46 发表
回xinjiana，project曾用过一段时间，功能很强大但我不熟悉，学习起来要耗费时间，而且打印输出是一个问题，后来放弃啦。
感谢yanjie版主的题目加分，也希望更多的EXCEL宏高手来参与这个题目。当然可能会影响到大家 ...

凡事都有个过程，慢慢习惯就好了，多找些书看看，
专业软件总有其专业之处

jonn

自己晚上挑灯研究 终于搞定啦，不敢独享，把源码公布如下。
哈哈，希望加分！
Sub CLANDAR2OL()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

     If cell.Value <> "" And _
     Cells(cell.Row, "F").Value <> "" And _
     Cells(cell.Row, "H").Value = "" Then

    Set olApp = New Outlook.Application
    Set olApt = olApp.CreateItem(olAppointmentItem)
       On Error Resume Next
    With olApt
    .Start = Cells(cell.Row, "F").Value + TimeValue("9:00:00")
    .End = Cells(cell.Row, "G").Value
    .Location = "GZ"
    .Subject = Cells(cell.Row, "B").Value
    .Body = Cells(cell.Row, "K").Value & ">" & Cells(cell.Row, "J").Value & ">" & Cells(cell.Row, "B").Value & ">" & Cells(cell.Row, "F").Value & ">" & Cells(cell.Row, "G").Value & ">" & Cells(cell.Row, "C").Value
    .AllDayEvent = False
    .BusyStatus = olBusy
    .IsOnlineMeeting = False
    .ReminderMinutesBeforeStart = 15
    .ReminderSet = True
    .Recipients = Cells(cell.Row, "C").Value
    .Recipients.Add = Cells(cell.Row, "D").Value
     .Display = True
    .Save
  
            End With
   Set olApt = Nothing
        End If
    Next cell
cleanup:
   Set olApp = Nothing
   Application.ScreenUpdating = True
End Sub

xinjiana

厉害，大家要都有你这样的钻研精神就好了

yanjie

谢谢很好！
看到有人这样通过日历文件夹来创建任务项目！这样也行吧：
Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(9)
    Set objAppt = objFolder.Items.Add
    With objAppt
        .Start = ......
        .End = ......
        .Subject = "......"
        .Body = ......
        .Save
    End With

cedrical

lz好棒~~~~

syboy1981

收藏了 以后用的上 outlook可以和手机同步