Outlook和Excel VBA任务计划程序

我迫切需要帮助，因为整个“系统”应该在本周完成，但作为vba脚本和代码等的新手，我不知道如何执行任务

我已经创建了一个excel，它根据到期日期生成每日电子邮件提醒，并希望使用任务计划程序每天打开它

我想要的是：

电脑在早上745点自动启动（最有可能使用bios电源管理）

电脑到达用户登录页面

任务调度器打开outlook，然后打开我的excel，并在上午8点发送电子邮件

保存并关闭Excel。（这是否需要excel中单独的宏或代码？）

使用任务计划程序关闭计算机

从我从其他人提出的各种页面/问题中发现，必须编写vbs/cmd脚本，但一些消息来源指出，在要运行该脚本的任务计划程序中，我不应该勾选“无论用户是否登录都运行”选项（我也不知道如何写，我只知道我必须把它写在记事本上，并保存在文件名的特定扩展名中） 希望有人能为我提供一个关于如何执行上述任务的详细指南。 另外，我尝试使用任务调度程序直接打开outlook应用程序，但它似乎不起作用。它也需要脚本吗

我的excel还需要其他帮助：目前，我的提醒宏仅在第一张工作表上运行。是否可以在所有工作表上运行

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 = "DEPARTMENT@EMAIL.COM" & ";COLLEAGUE@EMAIL.COM"
        .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

Dim Bcell作为范围
Dim iTo、iSubject、iBody作为字符串
模糊的重要级别，如字符串
公共子检查日期（）
对于范围内的每个B单元（“c2”、范围（“c”和行数）。结束（xlUp））
如果Bcell.Offset（0，5）为空，则“如果电子邮件列不为空，则命令继续
如果Now（）-Bcell.Offset（0，6）>0.9875，则如果当前时间在上次发送邮件后的23.7小时内，则不会发送“邮件”。
'示例：如果邮件在周一上午8点发送，则在周一上午8点到周二上午7:18之间，邮件将不会发送。
如果DateDiff（“d”，Now（），Bcell）=60，那么“如果c列中的日期是60天后，则将发送电子邮件。”
'Debug.Print Bcell.Row&'60'
iTo=b单元偏移量（0,5）
iSubject=“第一次提醒-在/ssgif编号中”&b单元偏移量（0，-2）
iBody=“亲爱的所有人”&vbCrLf&vbCrLf&_
“IN/SSGIF编号”&单元偏移量（0，-2）&“-”&单元偏移量（0,1）&“（批次：&单元偏移量（0,3）&）”，数量：&_
b单元格偏移量（0,2）和“&”，在“&b单元格偏移量（0，-1）和”通知，将在“&”到期_
Bcell&“&vbCrLf&”请确保寄售货物在到期日前结清，并尽快提交结清报告_
vbCrLf&vbCrLf&“谢谢”&vbCrLf&vbCrLf&“问候”&vbCrLf&“YYY部门”&_
vbCrLf和“XXX私人有限公司”
发送电子邮件
偏移量（0，6）=现在（）
如果结束
如果DateDiff（“d”，Now（），Bcell）=30，则“如果c列中的日期晚于30天，则将发送电子邮件。”
'Debug.Print Bcell.Row&'30'
iTo=b单元偏移量（0,5）
iSubject=“第二次提醒-在/ssgif编号中”&b单元偏移量（0，-2）
iBody=“亲爱的所有人”&vbCrLf&vbCrLf&_
“IN/SSGIF编号”&单元偏移量（0，-2）&“-”&单元偏移量（0,1）&“（批次：&单元偏移量（0,3）&）”，数量：&_
b单元格偏移量（0,2）和“&”，在“&b单元格偏移量（0，-1）和”通知，将在“&”到期_
Bcell&“&vbCrLf&”请确保寄售货物在到期日前结清，并尽快提交结清报告_
vbCrLf&vbCrLf&“谢谢”&vbCrLf&vbCrLf&“问候”&vbCrLf&“YYY部门”&_
vbCrLf和“XXX私人有限公司”
发送电子邮件
偏移量（0，6）=现在（）
如果结束
如果DateDiff（“d”，Now（），Bcell）=7，则“如果c列中的日期晚于30天，则将发送电子邮件。”
'Debug.Print“行：”&Bcell.ROW&“7”
iTo=b单元偏移量（0,5）
iSubject=“最终提醒-在/ssgif编号中”和b单元格偏移（0，-2）
iBody=“亲爱的所有人”&vbCrLf&vbCrLf&_
“IN/SSGIF编号”&单元偏移量（0，-2）&“-”&单元偏移量（0,1）&“（批次：&单元偏移量（0,3）&）”，数量：&_
b单元格偏移量（0,2）和“&”，在“&b单元格偏移量（0，-1）和”通知，将在“&”到期_
Bcell&“&vbCrLf&”请确保寄售货物在到期日前结清，并尽快提交结清报告_
vbCrLf&vbCrLf&“谢谢”&vbCrLf&vbCrLf&“问候”&vbCrLf&“YYY部门”&_
vbCrLf和“XXX私人有限公司”
发送电子邮件
偏移量（0，6）=现在（）
如果结束
如果结束
如果结束
伊藤=空
iSubject=空
iBody=空
下一个B单元
端接头
私有子SendEmail（）
Dim OutApp作为对象
将邮件变暗为对象
像弦一样暗的链子
Set-OutApp=CreateObject（“Outlook.Application”）
Set-OutMail=OutApp.CreateItem（0）
出错时继续下一步
发邮件
.To=iTo
.CC=”DEPARTMENT@EMAIL.COM" & ";COLLEAGUE@EMAIL.COM"
.BCC=“”
.Subject=issubject
.Body=iBody
.重要性=重要程度
'您可以添加这样的文件
'.Attachments.Add（“C:\test.txt”）
.展示
以
错误转到0
发送邮件=无
设置应用程序=无
端接头

现在Outlook已经运行，让我们创建一个带有提醒的定期任务项，并设置调用Excel的时间

带提醒的任务项

代码转到此Outlook会话下的Outlook

更新Excel路径

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

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

---

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

一次解决一个问题…好的，让我们从使用脚本？打开outlook和Excel？U开始

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