Results 1 to 2 of 2
  1. #1
    New Lounger
    Join Date
    Sep 2015
    Posts
    1
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Unhappy Outlook reminders from Excel - YES, AGAIN!

    Okay...I'm ignorant. I've seen numerous requests for Outlook reminders from Excel spreadsheets, but modifying the code is beyond my pay grade. I have a pretty simple spreadsheet that is used to track subpoenas and discoveries and calculate due dates. I'd like an Outlook reminder that includes the Name (A:A) and Subpoena served to (B:B) and whether it a subpoena or discovery in or discovery out based on the due date for the subpoena or discovery from columns E:E, I:I or M:M. Clear as mud? I would be very appreciative and blessed if someone could help me with this.

    Kind regards,
    Sisterchick
    Attached Files Attached Files

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    SisterChick,

    Here is your modified workbook with a class module and the code added that will create Task Reminders for your subpoenas. The code will examine each record and create the task for the specific type of reminder based on the column only if the Service/Served date has been entered. Once created, it will add a comment with a time stamp to the cell in the alert column. The comment has two functions: To alert you that a reminder has been created and to act as an inhibitor to prevent a reminder from being created twice. You can change the sheet name to anything you like as long as it remains the first sheet in the workbook. You can also add unlimited rows but do not alter the columns.

    HTH,
    Maud

    Discovery1.png

    Discovery2.png

    Discovery3.png

    Code:
    Public Sub Controller()
    '--------------------------------
    'DECLARE AND SET VARIABLES
        Dim LastRow As Long, I As Long, cell As Range
        LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row
    '--------------------------------
    'ADJUST NAMED RANGES
        ActiveWorkbook.Names("Subpoena").RefersTo = Worksheets(1).Range("D3:D" & LastRow)
        ActiveWorkbook.Names("DiscIn").RefersTo = Worksheets(1).Range("H3:H" & LastRow)
        ActiveWorkbook.Names("DiscOut").RefersTo = Worksheets(1).Range("L3:L" & LastRow)
    '--------------------------------
    'CHECK IF VALID DATE AND IF COMMENT PRESENT THEN CREATE REMINDER AND COMMENT
        For Each cell In Range("Subpoena")
            If IsDate(cell) And cell.Offset(0, 2).Comment Is Nothing Then
                SetReminders cell.row, cell.Column
                cell.Offset(0, 2).AddComment
                cell.Offset(0, 2).Comment.Text Text:="Task Reminder Created; " & Date & " " & Time
            End If
        Next cell
        For Each cell In Range("DiscIn")
            If IsDate(cell) And cell.Offset(0, 2).Comment Is Nothing Then
                SetReminders cell.row, cell.Column
                cell.Offset(0, 2).AddComment
                cell.Offset(0, 2).Comment.Text Text:="Task Reminder Created; " & Date & " " & Time
            End If
        Next cell
        For Each cell In Range("DiscOut")
            If IsDate(cell) And cell.Offset(0, 2).Comment Is Nothing Then
                SetReminders cell.row, cell.Column
                cell.Offset(0, 2).AddComment
                cell.Offset(0, 2).Comment.Text Text:="Task Reminder Created; " & Date & " " & Time
            End If
        Next cell
    End Sub
    
    
    Public Sub SetReminders(row As Long, col As Long)
    '--------------------------------
    'DECLARE AND SET VARIABLES
        Dim Task As ClsTaskEmail
        Set Task = New ClsTaskEmail
    '--------------------------------
    'SETUP TASK
        If Task.OutlookCheck = False Then Exit Sub
        Task.TaskStartDate = Cells(row, col)
        Task.TaskSubject = Cells(1, col) & " Due: " & Cells(row, col + 1)
        Task.TaskBody = Cells(1, col) & " Served: " & Cells(row, col) & vbNewLine & _
                        "Name: " & Cells(row, 1) & vbNewLine & _
                        "Served to: " & Cells(row, 2) & vbNewLine & _
                        "Due Date: " & Cells(row, col + 1)
        Task.TaskReminderset = True
        Task.TaskReminderDate = Cells(row, col + 1)
        Task.TaskImportance = 2
        Task.TaskCreate
    '--------------------------------
    'CLEANUP
        Set Task = Nothing
    End Sub
    Attached Files Attached Files
    Last edited by Maudibe; 2015-12-28 at 23:39.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •