1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Automatic Outlook mail due date reminder based on Excel file

Discussion in 'Business Applications' started by iamitp, Jul 7, 2014.

Thread Status:
Not open for further replies.
Advertisement
  1. iamitp

    iamitp Thread Starter

    Joined:
    Sep 28, 2006
    Messages:
    6
    Hi Everyone!

    This is my first post here. I need your help in developing a mechanism to send an automated outlook mail, when the due date of a project is 7 days away from the current date. The script should preferably run automatically every time the PC is running. without the excel file necessarily open.

    In the attached excel file, An email should go of to -email address (Col. D), with subject "Project (Col. B) is due on Due date(Col. C)", and body "Dear Name(Col. A), please update your project status".

    Also, the script should put a check mark on Reminder sent column (Col. E) after the mail is sent, the script should also check if the value of the cell is blank before sending email.

    I have scoured the forum for similar problems, and although I found a number of of threads,I am not proficient enough in VBA to modify them to my needs.

    I'd really appreciate any help,

    Thanks
     

    Attached Files:

  2. XCubed

    XCubed

    Joined:
    Feb 21, 2013
    Messages:
    520
    Here is some code that will generate the emails you want to send. Unfortunately the file must be open to run the macro. You can use the scheduler to open the file and run the macro automatically.


    Code:
    Sub eMail()
    Dim lRow As Integer
    Dim i As Integer
    Dim toDate As Date
    Dim toList As String
    Dim eSubject As String
    Dim eBody As String
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    Sheets(1).Select
    lRow = Cells(Rows.Count, 4).End(xlUp).Row
    For i = 2 To lRow
    toDate = Replace(Cells(i, 3), ".", "/")
      If Left(Cells(i, 5), 4) <> "Mail" And toDate - Date <= 7 Then
         Set OutApp = CreateObject("Outlook.Application")
         Set OutMail = OutApp.CreateItem(0)
            toList = Cells(i, 4)    'gets the recipient from col D
            eSubject = "Project " & Cells(i, 2) & " is due on " & Cells(i, 3)
            eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Please update your project status."
            
            On Error Resume Next
            With OutMail
            .To = toList
            .CC = ""
            .BCC = ""
            .Subject = eSubject
            .Body = eBody
            .bodyformat = 1
            .Display   ' ********* Creates draft emails. Comment this out when you are ready
            '.Send     '********** UN-comment this when you  are ready to go live
            End With
     
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
     Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
    End If
    Next i
    ActiveWorkbook.Save
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    End Sub
    
     

    Attached Files:

    shafique likes this.
  3. iamitp

    iamitp Thread Starter

    Joined:
    Sep 28, 2006
    Messages:
    6
    Thanks Xcubed! It works like a charm!

    Can you please help me modify the code so that the mail is sent (instead of opening the mail window).

    Amit
     
  4. XCubed

    XCubed

    Joined:
    Feb 21, 2013
    Messages:
    520
    near the end there is a .display and .send. uncomment the .send (delete the single quote) and add the quote to the .display, like so;




    Code:
    Sub eMail()
    Dim lRow As Integer
    Dim i As Integer
    Dim toDate As Date
    Dim toList As String
    Dim eSubject As String
    Dim eBody As String
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    Sheets(1).Select
    lRow = Cells(Rows.Count, 4).End(xlUp).Row
    For i = 2 To lRow
    toDate = Replace(Cells(i, 3), ".", "/")
      If Left(Cells(i, 5), 4) <> "Mail" And toDate - Date <= 7 Then
         Set OutApp = CreateObject("Outlook.Application")
         Set OutMail = OutApp.CreateItem(0)
            toList = Cells(i, 4)    'gets the recipient from col D
            eSubject = "Project " & Cells(i, 2) & " is due on " & Cells(i, 3)
            eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Please update your project status."
            
            On Error Resume Next
            With OutMail
            .To = toList
            .CC = ""
            .BCC = ""
            .Subject = eSubject
            .Body = eBody
            .bodyformat = 1
            '.Display   ' ********* Creates draft emails. Comment this out when you are ready
            .Send     '********** UN-comment this when you  are ready to go live
            End With
     
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
     Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
    End If
    Next i
    ActiveWorkbook.Save
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    End Sub
    
     
    Santhosh-7 likes this.
  5. iamitp

    iamitp Thread Starter

    Joined:
    Sep 28, 2006
    Messages:
    6
    Thank you so much!

    After I uncommented the relevant code, mail goes out perfectly! Only problem is when I change all three due dates to 14/07/2014 (within a week), one the first entry (row 2) is mailed ([email protected]) and only E2 has the text "Mail Sent 08/07/2014 15:01:32".The other rows are not being mailed.....
     
  6. XCubed

    XCubed

    Joined:
    Feb 21, 2013
    Messages:
    520
    it works for me. try with my test file.
     

    Attached Files:

    minhkhai likes this.
  7. iamitp

    iamitp Thread Starter

    Joined:
    Sep 28, 2006
    Messages:
    6
    Yes it is working great! Thanks a ton Xcubed! You are a genius :)
     
    shivarajed and newbie8963 like this.
  8. Sponsor

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1129238

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice