Outlook 和 Excel VBA 任务计划程序

Question

Am in desperate need for help as this whole "system" should be up by this week but being a totally novice to vba scripts and codes etc, I have no idea how to perform the tasks.

I have created an excel which generates daily email reminders based on due dates and would like to use task scheduler to get it opened daily.

What I want:

1. PC to auto boot up at 745am (most likely using bios power management)
2. PC reach user login page.
3. Task scheduler opens outlook, followed by my excel and sent out the emails at 8am.
4. Excel get saved and closed. (does this need a separate macro or code within the excel?)
5. Computer shut down using task scheduler.

From what I found out from various pages/questions asked by others, a vbs/cmd script have to be written, but some sources stated that in the task scheduler to run that script, I am not supposed to tick the option to "run whether user is logged on or not" (have no Idea how to write them as well, all I know is that I have to write it in notepad and save in the specific extension for the file name) Hope someone could provide me with a detailed guide on how to perform the above tasks. Also, I tried to use task scheduler to open the outlook app directly but it doesn't seem to work. Does it require a script as well?

Other help needed for my excel: currently, my reminder macro is running on the 1st sheet only. Is it possible for it to run on all sheets?

The code of the excel is as below:

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

Answer 1

Now that you have Outlook running, Lets create a Recurring Task Item with reminder and set the time that you would like to call Excel.

MSDN Application.Reminder Event (Outlook) Occurs immediately before a reminder is displayed.

Task Item with Reminder

Code goes to Outlook under ThisOutlookSession

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

Update Excel Path

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

Make sure to add Excel Library object to Outlook and macro security is enable to run

Tools - References then look for Microsoft Excel xxx Object Library