Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Excel - Email Notifications Reminders

Posted on 2008-10-20
5
Medium Priority
?
1,144 Views
Last Modified: 2011-10-19
I have a sheet that i have email notifications in. At the moment it sends an email if the date in column K is passed by 7 days. What i can't figure out is how to record the date that a 1st reminder is sent in column L and if necessary a second reminder in column M. After this the emails will need to stop being sent.
Job-Spreadsheet-2008.xls
0
Comment
Question by:Carlandrewlewis
  • 2
  • 2
5 Comments
 
LVL 39

Expert Comment

by:nutsch
ID: 22763575
Can you try this update to your macro:

Sub sendreminders()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    
    Set OutApp = CreateObject("outlook.application")
    OutApp.session.logon
    
    On Error GoTo cleanup
    Dim row As Integer
    Dim ws As Worksheet
    Set ws = Worksheets("sheet1")
    row = 2
    Do
        Dim col As Variant
        
If IsDate(ws.Cells(row, 11).Value) Then
 
    If DateDiff("d", Date, CDate(ws.Cells(row, 11).Value)) >= 7 Then
        If IsDate(ws.Cells(row, 13)) Then GoTo nxtRow
        If IsDate(ws.Cells(row, 12)) Then
            If DateDiff("d", Date, CDate(ws.Cells(row, 12).Value)) < 7 Then GoTo nxtRow
        End If
        
        Set OutMail = OutApp.createitem(0)
                
        On Error Resume Next
        With OutMail
            .To = "c.lewis@caswell-group.co.uk"
            .Subject = " Reminder for " & ws.Cells(row, 1) & " " & ws.Cells(row, 2) & " Has not been priced and was recieved on " & ws.Cells(row, 11)
            .Body = "Dear Carl" & vbNewLine & vbNewLine & _
                " Please note that " & ws.Cells(row, 1) & " " & ws.Cells(row, 2) & " Has not been priced and was recieved on " & ws.Cells(row, 11)
            .Send
        End With
        
        If IsDate(ws.Cells(row, 12)) Then ws.Cells(row, 13) = Date Else ws.Cells(row, 12) = Date
    
    On Error GoTo 0
                  
    Set OutMail = Nothing
 
    End If
End If
    
nxtRow:
 
    row = row + 1
    Loop Until ws.Cells(row, 1) = ""
    
cleanup: Set OutMail = Nothing
        
End Sub

Open in new window

0
 

Author Comment

by:Carlandrewlewis
ID: 22765161
I have tried and it doesn't seem to do anything??  Here is code for one that i already use but i don't know how to copy it across so it applies...

Sub sendRemindersForWorksheet(ByRef ws As Worksheet)
    Dim row As Long, i As Long, n As Long
    Dim sReminder As String, sMessage As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim datLast As Date, datNext As Date
   
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
 
    On Error GoTo cleanup
   
    n = ws.Cells(Rows.Count, 1).End(xlUp).row
    For row = 2 To n
        sReminder = ""
        datLast = Application.Max(ws.Rows(row))
        datNext = datLast + 30
        If datLast > 0 Then
            i = ws.Rows(row).Find(datLast).Column
            Select Case Date - datLast
            Case Is >= 30
                If ws.Cells(row, i + 2) = "" Then
                    sReminder = "Last" 'Needs the Last reminder
                    ws.Cells(row, i + 2).Value = sReminder & Format(Date, " d/m") ' mark as sent
                End If
            Case Is >= 15
                If ws.Cells(row, i + 1) = "" Then
                    sReminder = "1st" 'Needs the 1st reminder
                    ws.Cells(row, i + 1).Value = sReminder & Format(Date, " d/m") ' mark as sent
                End If
            End Select
            If sReminder <> "" Then
                sMessage = ws.Cells(row, 1) & " " & ws.Cells(row, 2) & " in van " & ws.Cells(row, 3) & _
                    " needs a new van air test by " & Format(datNext, "d mmmm")
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = "test@test.co.uk"          'Please put in the correct e-mail address
                    .Subject = sReminder & " Reminder for " & sMessage
                    .Body = "Dear Carl" & vbNewLine & vbNewLine & "Please note that " & sMessage
                    .Send
                End With
            End If
        End If
    Next
       
    Set OutMail = Nothing
   
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 22887235
Cannot get a good download of your file to test but try the following:

Should put the dates into columns L & M for first and final reminder respectively.  The code looks as though it should only snd the two emails so if this does not work can you suggest any senarios that cause the excess sending.

Chris
Sub sendRemindersForWorksheet(ByRef ws As Worksheet)
    Dim row As Long, i As Long, n As Long
    Dim sReminder As String, sMessage As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim datLast As Date, datNext As Date
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
 
    On Error GoTo cleanup
    
    n = ws.Cells(Rows.Count, 1).End(xlUp).row
    For row = 2 To n
        sReminder = ""
        datLast = Application.Max(ws.Rows(row))
        datNext = datLast + 30
        If datLast > 0 Then
            i = ws.Rows(row).Find(datLast).Column
            Select Case Date - datLast
            Case Is >= 30
                If ws.Cells(row, i + 2) = "" Then
                    sReminder = "Last" 'Needs the Last reminder
                    ws.Cells(row, i + 2).Value = sReminder & Format(Date, " d/m") ' mark as sent
                    ws.Cells(row, 13).Value = Format(Date, " d/m")
                End If
            Case Is >= 15
                If ws.Cells(row, i + 1) = "" Then
                    sReminder = "1st" 'Needs the 1st reminder
                    ws.Cells(row, i + 1).Value = sReminder & Format(Date, " d/m") ' mark as sent
                    ws.Cells(row, 12).Value = Format(Date, " d/m")
                End If
            End Select
            If sReminder <> "" Then
                sMessage = ws.Cells(row, 1) & " " & ws.Cells(row, 2) & " in van " & ws.Cells(row, 3) & _
                    " needs a new van air test by " & Format(datNext, "d mmmm")
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = "test@test.co.uk"          'Please put in the correct e-mail address
                    .Subject = sReminder & " Reminder for " & sMessage
                    .Body = "Dear Carl" & vbNewLine & vbNewLine & "Please note that " & sMessage
                    .Send
                End With
            End If
        End If
    Next
        
    Set OutMail = Nothing
    
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 23371496
Carlandrewlewis

Any Update?

Chris
0
 

Author Closing Comment

by:Carlandrewlewis
ID: 31507894
Chris, sorry for the major delay, i have been working away therefore not been able to confirm this. Anyway thanks for your help!!!
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Gain an elementary understanding of Blockchain technology.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

971 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question