Outlook和Excel VBA任务计划程序

由于这个“系统”应该在本周上涨，但是对于vba脚本和代码等是一个完全新手，所以急需帮助，我不知道如何执行任务。

我创build了一个excel，根据到期date生成每日电子邮件提醒，并希望使用任务计划程序将其打开。

我想要的是：

1. PC在7时45分自动启动（很可能使用BIOS电源pipe理）
2. PC到达用户login页面。
3. 任务调度程序打开Outlook，然后是我的Excel，并在上午8点发送电子邮件。
4. Excel保存并closures。 （这是否需要Excel中的一个单独的macros或代码？）
5. 计算机使用任务计划程序closures。

从我从其他人发现的各种页面/问题中发现，必须编写一个vbs / cmd脚本，但是一些消息来源指出，在任务调度程序中运行该脚本，我不应该勾选“是否运行用户login或不“（不知道如何写他们，我知道的是，我必须写在记事本，并保存在文件名的具体扩展名）希望有人能够提供一个详细的指南关于如何执行上述任务。 此外，我试图使用任务调度程序直接打开Outlook应用程序，但它似乎并没有工作。 它是否也需要脚本？

其他帮助我的Excel中需要：目前，我的提醒macros只在第一张纸上运行。 它可以在所有的床单上运行吗？

excel的代码如下：

Dim Bcell As Range Dim iTo, iSubject, iBody As String Dim ImportanceLevel As String Public Sub CheckDates() For Each Bcell In Range("c2", Range("c" & Rows.Count).End(xlUp)) If Bcell.Offset(0, 5) <> Empty Then ' if email column is not empty then command continues If Now() - Bcell.Offset(0, 6) > 0.9875 Then ' mail will not be sent if current time is within 23.7 hours from time of mail last sent. ' Example: if mail is sent at 8am monday, between 8am monday to tuesday 7:18am, mail will not be sent. If DateDiff("d", Now(), Bcell) = 60 Then ' if date in column c is 60days later, email will be sent ' Debug.Print Bcell.Row & " 60" iTo = Bcell.Offset(0, 5) iSubject = "FIRST REMINDER - IN/SSGIFR no. " & Bcell.Offset(0, -2) iBody = "Dear all," & vbCrLf & vbCrLf & _ "IN/SSGIFR No. " & Bcell.Offset(0, -2) & " - " & Bcell.Offset(0, 1) & " (Batch: " & Bcell.Offset(0, 3) & ", Qty: " & _ Bcell.Offset(0, 2) & ")" & ", notified on " & Bcell.Offset(0, -1) & " will be due on " & _ Bcell & "." & vbCrLf & "Please ensure that the consignment is closed by the due date and forward the closure reports ASAP." & _ vbCrLf & vbCrLf & "Thank you" & vbCrLf & vbCrLf & "Regards," & vbCrLf & "YYY Department" & _ vbCrLf & "XXX Pte Ltd." SendEmail Bcell.Offset(0, 6) = Now() End If If DateDiff("d", Now(), Bcell) = 30 Then ' if date in column c is 30 days later, email will be sent ' Debug.Print Bcell.Row & " 30" iTo = Bcell.Offset(0, 5) iSubject = "SECOND REMINDER - IN/SSGIFR no. " & Bcell.Offset(0, -2) iBody = "Dear all," & vbCrLf & vbCrLf & _ "IN/SSGIFR No. " & Bcell.Offset(0, -2) & " - " & Bcell.Offset(0, 1) & " (Batch: " & Bcell.Offset(0, 3) & ", Qty: " & _ Bcell.Offset(0, 2) & ")" & ", notified on " & Bcell.Offset(0, -1) & " will be due on " & _ Bcell & "." & vbCrLf & "Please ensure that the consignment is closed by the due date and forward the closure reports ASAP." & _ vbCrLf & vbCrLf & "Thank you" & vbCrLf & vbCrLf & "Regards," & vbCrLf & "YYY Department" & _ vbCrLf & "XXX Pte Ltd." SendEmail Bcell.Offset(0, 6) = Now() End If If DateDiff("d", Now(), Bcell) = 7 Then ' if date in column c is 30days later, email will be sent ' Debug.Print "ROW: " & Bcell.Row & " 7" iTo = Bcell.Offset(0, 5) iSubject = "FINAL REMINDER - IN/SSGIFR no. " & Bcell.Offset(0, -2) iBody = "Dear all," & vbCrLf & vbCrLf & _ "IN/SSGIFR No. " & Bcell.Offset(0, -2) & " - " & Bcell.Offset(0, 1) & " (Batch: " & Bcell.Offset(0, 3) & ", Qty: " & _ Bcell.Offset(0, 2) & ")" & ", notified on " & Bcell.Offset(0, -1) & " will be due on " & _ Bcell & "." & vbCrLf & "Please ensure that the consignment is closed by the due date and forward the closure reports ASAP." & _ vbCrLf & vbCrLf & "Thank you" & vbCrLf & vbCrLf & "Regards," & vbCrLf & "YYY Department" & _ vbCrLf & "XXX Pte Ltd." SendEmail Bcell.Offset(0, 6) = Now() End If End If End If iTo = Empty iSubject = Empty iBody = Empty Next Bcell End Sub Private Sub SendEmail() Dim OutApp As Object Dim OutMail As Object Dim strbody As String Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = iTo .CC = "[e-mail]" & ";[e-mail]" .BCC = "" .Subject = iSubject .Body = iBody .Importance = ImportanceLevel 'You can add a file like this '.Attachments.Add ("C:\test.txt") .Display End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub 

Answer 1

现在您已经运行了Outlook，现在使用提醒创build一个重复任务项目，并设置您想要调用Excel的时间。

任务项目与提醒

代码在ThisOutlookSession下进入Outlook

 Private Sub Application_Reminder(ByVal Item As Object) If TypeOf Item Is Outlook.TaskItem Then If Not Item.Subject = "Send Report" Then Exit Sub End If End If GetTemp Item ' call sub End Sub Private Sub GetTemp(ByVal Item As TaskItem) Dim xlApp As Excel.Application Dim xlBook As Workbook Set xlApp = New Excel.Application Set xlBook = xlApp.Workbooks.Open("C:\Temp\Excel_File.xlsm") ' update with Excel name xlApp.Visible = True ' // Run Macro in Excel_File xlBook.Application.Run "Module1.CheckDates" ' Update with subname Set xlApp = Nothing Set xlBook = Nothing End Sub 

更新Excelpath

 xlApp.Workbooks.Open("C:\Temp\Excel_File.xlsm") 

确保将Excel库对象添加到Outlook，并启用macros安全性运行

工具 – 参考然后查找Microsoft Excel xxx对象库