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

ck1668 · 发表于 2006-3-2 08:11

总版主，及各位大侠，麻烦您们再帮忙修改一下代码，好吗？

另外，请总版主帮我解释一下您的代码中各语句的作用，多谢！

lotustower · 发表于 2006-3-2 12:26

Option Explicit ' Set reference to Microsoft Excel 11 Object Library 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 Dim LastRow As Integer Dim RowsCount As Integer Dim Msg As String Dim Rng As Range Set XL_app = CreateObject("Excel.Application") Set XL_wb = XL_app.Workbooks.Open("E:\OL_Reminder.xls") Bodytxt = "今天到期生產單號" & Chr(10) With XL_app.Workbooks("OL_Reminder.xls").Sheets(2) Set Rng = ActiveSheet.Range("A8:N" & Range("A65536").End(xlUp).Row) ' Assume Row 8 is header Rng.AutoFilter Field:=11, Criteria1:="今天到期" Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, Rng.Columns.Count) On Error Resume Next Set Rng = Rng.Columns(1).SpecialCells(xlCellTypeVisible) If Err = 0 Then For i = 1 To Rng.Count Bodytxt = Bodytxt & Range("B" & Rng.Cells(i, 1).Row) & Chr(10) Next Else Err.Clear Bodytxt = "今天沒有到期生產單號!" End If Selection.AutoFilter Cells(9, 1).Select 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 XL_app.Quit Set XL_app = Nothing End Sub

[此贴子已经被作者于2006-3-3 13:41:49编辑过]

lotustower · 发表于 2006-3-2 14:04

XL_app.ActiveWorkbook.Saved = True
XL_app.Workbooks.Close
XL_app.Quit ' Is it better to Quit Excel ??
Set XL_app = Nothing

ck1668 · 发表于 2006-3-2 15:54

Dear lotustower，您好！

真的不好意思，麻烦您们这么久，由于我对代码一点都不懂，故您上面的代码麻烦您告诉我是放到哪里的

１）22楼的代码是放到Outlook里？还是放到Excel里？其中您分四个颜色分别代表什么？特别是红色字体。

２）23楼的代码又代表什么？又是放到哪里的？

多谢！

刚才试着把您的代码放到Outlook里，出现＂语法错误＂对话框，请看附件。再补充：我又试着将您的代码放到Excel里，虽然没有出现＂语法错误＂对话框，但已于2006-2-18 落单的8363这个单还是一样出现在Outlook的提醒视窗里。 Sorry！给错附件，现重新上传。

ef0bBFEc.rar (72.89 KB, 下载次数: 8)

[此贴子已经被作者于2006-3-2 16:39:09编辑过]

lotustower · 发表于 2006-3-2 17:27

在 OutLook 內！

22/F Bodytxt = "今天到期生產單號" & Chr(10)

這句少了"

Sorry ！！！

lotustower · 发表于 2006-3-2 17:35

再抄 22/F 到 OutLook

ck1668 · 发表于 2006-3-2 19:40

以下是引用[I]lotustower[/I]在2006-3-2 17:35:29的发言：[BR]再抄 22/F 到 OutLook

我再抄 22/F 到 OutLook，却另一处出错，请看附件。谢！

uTVYPMwS.rar (84.11 KB, 下载次数: 11)

lotustower · 发表于 2006-3-2 22:22

你用的 E:\OL_Reminder.xls 是同上傳？

ck1668 · 发表于 2006-3-3 08:17

Dear lotustower，您好！

我用的是E:\OL_Reminder.xls ，这个EXCEL里面的代码是chijanzen写的，Outlook里的代码是抄您22/F 的，出错的代码是这一句：Selection.AutoFilter Field:=11, Criteria1:="今天到期"。

如果Outlook用回之前 Kevin的代码，则正是出现您上面图片中的生产单号，但其中的8363已经于2006-2-18提前落单了，故应该不能出现在Outlook的提醒视窗里。

故我想您帮我修改一下代码，让它参照 K 栏和 B 栏，而不要参照 I 栏和 B 栏。多谢！

[此贴子已经被作者于2006-3-3 8:30:08编辑过]

lotustower · 发表于 2006-3-3 13:39

再抄 22/F 到 OutLook

[em06]

Or Import

zjU0aMQb.zip (1.12 KB, 下载次数: 16)

[此贴子已经被作者于2006-3-3 13:43:04编辑过]

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