+ Reply to Thread
Results 1 to 3 of 3

Send Emails once expiry date is reached, and generate report based on emails sent

  1. #1
    Registered User
    Join Date
    11-16-2013
    Location
    Abu Dhabi
    MS-Off Ver
    Excel 2010
    Posts
    3

    Post Send Emails once expiry date is reached, and generate report based on emails sent

    Good Day to all excel gurus out there

    this forum is really a vault of knowledge has really helped me out greatly in the past

    i need your wisdom guys to help me out with enhancing my code to carry out 2 functions.

    let me explain what i am trying to do, and what i have done so far.

    I have a workbook that contains multiple sheets for different clients, and each sheet has details of documents relating to each client documentations and expiry date for these documents. each of these sheet has a an RM that is responsible to follow up. All the sheets are identical formatting wise, number of columns number of rows.

    What i am trying to do is run a macro that scans through the expiry date column of each sheet, and scans all the rows till it cannot find any more dates. It is supposed to check which documents is expiring within the next 30 days and send a first reminder to the respective RM whose email is also included in the sheet with specific details about the client and the type of document that is about to expire. Also when you run the macro again if no reminder 1 was sent to send an email and fill in the current date when reminder 1 is sent. If reminder 1 already has a date to send a 2nd reminder and fill it in with todays date. for this part i have already written the code and it is working beautifully.. please see the code below.

    Now what i want to do is if any of the expiry dates have been updated and therefore it does not fall within the 30 days expiry period, on the execution of the macro it should clear the reminders automatically and reset the cell values respectively.

    Also everytime the macro runs and it detects an expired documents and send an email i want to be able to generate a report based on the emails that were sent.

    Lets say the macro generated 10 emails for 10 expired documents sent to 5 different RMS, i want to be able to see RM Name, Document Name, Expiry Date, date reminder was sent. All these values are available in the actual sheet, i just need to be able to reference it once the macro is executed. Somehow try to integrate it into the originally existing code.

    Id greatly appreciate any help you guys can provide ive been trying to sort this out for a few weeks now my brain is fried



    Option Explicit

    Public Sub SendReminderNotices()

    Dim WS_Count As Integer
    Dim z As Integer

    ' Set WS_Count equal to the number of worksheets in the active
    ' workbook.
    WS_Count = ActiveWorkbook.Worksheets.Count

    ' Begin the loop.
    For z = 1 To WS_Count

    ' Insert your code here.

    ' ****************************************************************
    ' Define Variables
    ' ****************************************************************
    Dim wkbReminderList As Workbook
    Dim wksReminderList As Worksheet
    Dim lngNumberOfRowsInReminders As Long
    Dim I As Long

    ' ****************************************************************
    ' Set Workbook and Worksheet Variables
    ' ****************************************************************
    Set wkbReminderList = ActiveWorkbook
    Set wksReminderList = ActiveWorkbook.Worksheets(z)

    ' ****************************************************************
    ' Determine How Many Rows Are In the Worksheet in Column A
    ' ****************************************************************
    lngNumberOfRowsInReminders = wksReminderList.Cells(Rows.Count, "H").End(xlUp).Row

    ' ****************************************************************
    ' For Any Items That Don't Have A Date In Column K
    ' Check To See If The Reminder Is Due.
    '
    ' If Reminder Is Due, then Send An Email.
    ' If Successful, Log The Date Sent in Column K
    ' ****************************************************************

    For I = 10 To lngNumberOfRowsInReminders
    ' ****************************************************************
    ' Check If The Item Was Already Emailed
    ' ****************************************************************
    If wksReminderList.Cells(I, 10) <> "" Then
    If wksReminderList.Cells(I, 11) = "" Then
    ' ****************************************************************
    ' If A Reminder Was Not Sent, Then Check To See if Within 30 Days
    ' ****************************************************************
    If wksReminderList.Cells(I, 8) <= Date + 30 Then
    ' ****************************************************************
    ' Send An Email Message And Check To See That It Is Successful
    ' ****************************************************************
    If SendAnOutlookEmail(wksReminderList, I) Then
    wksReminderList.Cells(I, 11) = Date 'Indicate That Reminder1 Was Successful
    End If
    End If
    ' ****************************************************************
    ' Second Reminder Date Check
    ' ****************************************************************
    Else
    If wksReminderList.Cells(I, 11) <> "" Then
    If wksReminderList.Cells(I, 12) = "" Then
    If wksReminderList.Cells(I, 8) <= Date Then
    If SendAnOutlookEmail2(wksReminderList, I) Then
    wksReminderList.Cells(I, 12) = Date 'Indicate That Reminder2 Was Successful
    End If
    End If
    End If
    End If
    End If
    End If
    Next I

    ' The following line shows how to reference a sheet within
    ' the loop by displaying the worksheet name in a dialog box.


    Next z


    End Sub


    Private Function SendAnOutlookEmail(WorkSheetSource As Worksheet, RowNumber As Long) As Boolean




    Dim strMailToEmailAddress As String
    Dim strSubject As String
    Dim strBody As String
    Dim OutApp As Object
    Dim OutMail As Object



    SendAnOutlookEmail = False

    strMailToEmailAddress = WorkSheetSource.Cells(3, 6)
    strSubject = "Reminder Notification" & " - CIF " & WorkSheetSource.Cells(3, 4) & " - " & WorkSheetSource.Cells(2, 4)
    strBody = WorkSheetSource.Cells(RowNumber, 6) & " - " & WorkSheetSource.Cells(RowNumber, 9) & " is expiring on " & Format(WorkSheetSource.Cells(RowNumber, 8), "DD-MM-YYYY")

    ' ****************************************************************
    ' Create The Outlook Mail Object
    ' ****************************************************************
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)

    ' ****************************************************************
    ' Send The Email
    ' ****************************************************************
    On Error GoTo ErrorOccurred
    With OutMail
    .To = strMailToEmailAddress
    .Subject = strSubject
    .Body = strBody
    .Send
    End With

    ' ****************************************************************
    ' Mail Was Successful
    ' ****************************************************************
    SendAnOutlookEmail = True

    Continue:
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    Exit Function

    ' ****************************************************************
    ' Mail Was Not Successful
    ' ****************************************************************
    ErrorOccurred:

    Resume Continue



    End Function


    Private Function SendAnOutlookEmail2(WorkSheetSource As Worksheet, RowNumber As Long) As Boolean




    Dim strMailToEmailAddress As String
    Dim strSubject As String
    Dim strBody As String
    Dim OutApp As Object
    Dim OutMail As Object



    SendAnOutlookEmail2 = False

    strMailToEmailAddress = WorkSheetSource.Cells(3, 6)
    strSubject = " 2nd Reminder Notification" & " - CIF " & WorkSheetSource.Cells(3, 4) & " - " & WorkSheetSource.Cells(2, 4)
    strBody = WorkSheetSource.Cells(RowNumber, 6) & " - " & WorkSheetSource.Cells(RowNumber, 9) & " is expiring on " & Format(WorkSheetSource.Cells(RowNumber, 8), "DD-MM-YYYY")

    ' ****************************************************************
    ' Create The Outlook Mail Object
    ' ****************************************************************
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)

    ' ****************************************************************
    ' Send The Email
    ' ****************************************************************
    On Error GoTo ErrorOccurred
    With OutMail
    .To = strMailToEmailAddress
    .Subject = strSubject
    .Body = strBody
    .Send
    End With

    ' ****************************************************************
    ' Mail Was Successful
    ' ****************************************************************
    SendAnOutlookEmail2 = True

    Continue:
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    Exit Function

    ' ****************************************************************
    ' Mail Was Not Successful
    ' ****************************************************************
    ErrorOccurred:

    Resume Continue



    End Function

    ******************************************---------------------------------*******************************

  2. #2
    Registered User
    Join Date
    11-16-2013
    Location
    Abu Dhabi
    MS-Off Ver
    Excel 2010
    Posts
    3

    Re: Send Emails once expiry date is reached, and generate report based on emails sent

    can anyone help me?

  3. #3
    Registered User
    Join Date
    11-16-2013
    Location
    Abu Dhabi
    MS-Off Ver
    Excel 2010
    Posts
    3

    Re: Send Emails once expiry date is reached, and generate report based on emails sent

    i can provide a sample of the excel file if it would help

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] Macro To Send Emails with PDF: Multiple Emails and PDF's
    By totoga12 in forum Excel Programming / VBA / Macros
    Replies: 16
    Last Post: 03-19-2014, 06:13 PM
  2. Auto Send Emails Based on Due Date
    By Nuclearman83 in forum Excel General
    Replies: 5
    Last Post: 03-23-2012, 02:54 PM
  3. Send outlook emails with message in cells to individual emails associated with them
    By abinayan in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 12-21-2011, 06:11 AM
  4. Sending macro emails using excel: Send emails with their passwords.
    By loveisblind in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 10-12-2009, 03:16 PM
  5. Send Mail Merge Auto-Emails based on date
    By Phillycheese5 in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 11-17-2005, 11:40 AM

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1