求助：excel表里到期的项目在Outlook的行事历里自动出现提示

Kevin · 发表于 2006-2-28 11:47

唉，楼主，我真是要被你打败了，请再仔细读一下2楼的贴！！！

[此贴子已经被作者于2006-2-28 11:49:24编辑过]

ck1668 · 发表于 2006-2-28 12:01

以下是引用[I]Kevin[/I]在2006-2-28 11:47:28的发言：[BR]唉，楼主，我真是要被你打败了，请再仔细读一下2楼的贴！！！

总版主，我是按照您２楼的方法，先将您２楼很长的代码写在Outlook的ThisOutlookSession中，又引用Excel对象，同时把源数据文件保存为E:\OL_Reminder.xls。但Outlook中就是没有出现提醒视窗。现附上附件，请您帮我看看是不是这样的。多谢！

psp2mAPW.rar (14.23 KB, 下载次数: 17)

ck1668 · 发表于 2006-2-28 13:54

总版主，我是这样做的，您帮我看看是不是我把代码搞错了。１）将您２楼的以下代码写在Outlook的ThisOutlookSession中，然后引用Excel对象 Option Explicit Private Sub Application_Startup() CreateNewAM End Sub Private Sub CreateNewAM() Dim XL_app As Excel.Application Dim XL_wb As Excel.Workbook Dim OLAitem As Outlook.AppointmentItem Dim Bodytxt As String Dim i As Integer Set XL_app = CreateObject("Excel.Application") Set XL_wb = XL_app.Workbooks.Open("E:OL_Reminder.xls") Bodytxt = "今天到期生產單號" & Chr(10) i = 9 With XL_app.Workbooks("OL_Reminder.xls").Sheets(2) Do While .Cells(i, 9) <> "" If CDate(.Cells(i, 9)) = Date Then Bodytxt = Bodytxt & .Cells(i, "B") & Chr(10) End If i = i + 1 Loop End With On Error GoTo 0 Set OLAitem = CreateItem(olAppointmentItem) '工作 On Error Resume Next With OLAitem .Subject = "今天到期的工作" .Start = Now .End = Now .ReminderMinutesBeforeStart = 30 '30分鐘前提醒 .Body = Bodytxt .Save .Display End With XL_app.ActiveWorkbook.Saved = True XL_app.Workbooks.Close Set XL_app = Nothing End Sub ２）将chijanzen 写的以下代码放在Excel的 VBA Project里。 Sub ListmatureItem() Dim OLapp As Outlook.Application Dim OLAitem As Outlook.AppointmentItem Bodytxt = "今天到期生產單號" & Chr(10) i = 9 With Sheet4 Do While .Cells(i, "I") <> "" If CDate(.Cells(i, "I")) = Date Then Bodytxt = Bodytxt & .Cells(i, "B") & Chr(10) End If i = i + 1 Loop End With On Error Resume Next Set OLapp = GetObject(, "Outlook.Application") If Err.Number Then Err.Clear Set OLapp = CreateObject("Outlook.Application") End If On Error GoTo 0 Set OLAitem = OLapp.CreateItem(olAppointmentItem) '工作 On Error Resume Next With OLAitem .Subject = "今天到期的工作" .Start = Now .End = Now .ReminderMinutesBeforeStart = 30 '30分鐘前提醒 .Body = Bodytxt .Save .Display End With Set OLcont = Nothing Set OLapp = Nothing End Sub

[此贴子已经被作者于2006-2-28 13:58:15编辑过]

wclaw · 发表于 2006-2-28 15:55

Outlook Security Setting

ck1668 · 发表于 2006-2-28 16:40

现在终于出现提醒视窗了，但没有显示相对应的生产单号，请看附件。并帮忙看看如何才能再进一步显示到期的生产单号？多谢！

84dIM68l.rar (40.84 KB, 下载次数: 22)

[此贴子已经被作者于2006-2-28 16:42:24编辑过]

wclaw · 发表于 2006-2-28 17:31

XL_app.Workbooks.Open("E:OL_Reminder.xls")

XL_app.Workbooks.Open("E:\OL_Reminder.xls")

Kevin · 发表于 2006-2-28 18:00

楼主，如果你对VBA一点点都不了解，麻烦请使用第一次提问时使用的附件来测试，不要自行修改这个文件！当时这个Excel文件里面只有两个工作表，没有任何代码，现在被你加了一大堆无用信息进去！！

ck1668 · 发表于 2006-2-28 20:28

总版主，您的意思是两个工作表与多个工作表的效果会不一样，是吗？但代码应该没错啊，Excel里的代码是copy chijanzen的，Outlook里的代码是copy您的。

如果是这样的话，那再麻烦您帮我再修改一下附件，以及附件的VBA代码,好吗？非常感谢！

ck1668 · 发表于 2006-2-28 21:08

以下是引用[I]wclaw[/I]在2006-2-28 17:31:40的发言：[BR]
XL_app.Workbooks.Open("E:OL_Reminder.xls")
XL_app.Workbooks.Open("E:\OL_Reminder.xls")

您好！您上面两个我都试过，但都不能显示到期的生产单号。

ck1668 · 发表于 2006-3-1 08:40

总版主，太感谢您和chijanzen，lotustower，wclaw等几位高手的帮忙！今天一早我打开Outlook，提醒视窗里终于出现生产单号了，只是出现的单号还不很正确，请看附件里的8363这个单，它已于2006-2-18 落单了，并且在k栏显示的是 "提前11天"，但却也显示在提醒视窗里。我看了一下您和chijanzen的代码，可能是因为参照I栏和B栏的缘故，由于我对VBA一点都不懂，故还要麻烦您和chijanzen帮我修改一下代码，让它参照K栏（不参照I栏）和B栏，即K栏若出现”今天到期”，则提醒视窗里就出现B栏相对应的生产单号。多谢您们！

cpgo4vjG.rar (39.41 KB, 下载次数: 17)

[此贴子已经被作者于2006-3-1 8:40:52编辑过]

		自动登录	找回密码
密码			免费注册