Outlook Task Scheduler and Excel VBA

In desperate need of help, since this whole "system" should be this week, but, being a complete beginner in vba scripts and codes, etc., I have no idea how to complete the tasks.

I created excel that generates daily email reminders based on deadlines and would like to use a task scheduler to open it daily.

What I want:

  • PC to automatically boot into 745am (most likely using BIOS power management)
  • PC login page.
  • Task Scheduler opens Outlook and then my excel and sends emails at 8am.
  • Excel will be saved and closed. (do i need a separate macro or code in excel?)
  • Shutting down the computer using the task scheduler.

From what I learned from different pages / questions asked by others, I need to write a vbs / cmd script, but some sources said that in the task scheduler to run this script, I should not specify the option “whether the user is logged in or not” (have no idea how to write them as well, all I know is that I have to write it to notepad and save it in a specific extension for the file name) I hope someone can provide me with a detailed guide on how to complete the above tasks. In addition, I tried using the task scheduler to open Outlook directly, but it does not seem to work. Is a script also required?

, excel: 1- . , ?

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
+1
1

, Outlook, , Excel.

MSDN Application.Reminder(Outlook) .

enter image description here

Outlook 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

Excel

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

, Outlook Excel,

- , Microsoft Excel xxx

+1

Source: https://habr.com/ru/post/1695335/


All Articles