Generate Automatic Email based on Date in Excel doc

[suet]

Hi

I have an excel document that contains Defects Date.

I need to generate an email that will look at the Defects Date and email me 4 months before that Defects Date is dude.

Could someone please advise how I would go about coding this into the workbook.

I would really appreciate any advise/guidance on VBA code that needs to be used.

Kind Regards
Sue

 

[gordsky]

Hi

I have an excel document that contains Defects Date.

I need to generate an email that will look at the Defects Date and email me 4 months before that Defects Date is dude.

Could someone please advise how I would go about coding this into the workbook.

I would really appreciate any advise/guidance on VBA code that needs to be used.

Kind Regards
Sue

how do you want the email to be triggered. It would need something like a workbook_open event so that on opening the file it would check the dates and email you if criteria met. You would need to add some sort of helper column to also identify when an email has already been sent as it would send repeat emails based on the criteria otherwise.

 

[suet]

Hi Gordsky

Thank you for your reply. I would need the emails to generate once the workbook is opened but I have no idea of VBA coding. I did try to attach a copy of the workbook but it won't let me.

Regards
Sue

 

[gordsky]

Hi Gordsky

Thank you for your reply. I would need the emails to generate once the workbook is opened but I have no idea of VBA coding. I did try to attach a copy of the workbook but it won't let me.

Regards
Sue

as above you will need a helper column to avoid duplicate emails.
Also what info do you require in the email and do you want a seperate email for each entry (should there be more than 1) or all on one email

 

[suet]

as above you will need a helper column to avoid duplicate emails.
Also what info do you require in the email and do you want a seperate email for each entry (should there be more than 1) or all on one email

Hiya

I just need to look at the date and if its 4 months from today's date then I need to generate an email with some basic text reminding myself that the defects report is now due for that client and I need to take the data from the excel document for reference:

Example

Your defects handover date is due 4 months from today for

R170074

Littlemore Park (Phase A), Oxford

Citizen

Hills

A

Shared Ownership

196

80 Atwater House, Armstrong Road, Oxford, OX4 4RU

Please action and contact client.

The data in the table is what needed to be exported from the spreadsheet into the email so the reminder is clear.

Does that make sense?

Regards
Sue

 

[gordsky]

yes makes sense, you didnt answer where you want the helper column placed.

 

[suet]

yes makes sense, you didnt answer where you want the helper column placed.

Hiya

The helper column at be any blank column so column M or No.

I really appreciate your time and assistance with this query.

Regards
Sue x

 

[gordsky]

Ok so think I have this as you need.
Copy the code below into the "THISWORKBOOK" module and mak the changes shown in GREEN to reflect your sheetname, email address etc etc and save as a Macro Enabled Workbook. (the last .display can be changed to .send once you have testd and then the email will auto send)

Option Explicit
Option Compare Text
Private Sub Workbook_Open()

Dim ws As Worksheet
Dim cel As Range, Rng As Range
Dim lrow As Long, StDte As Long, EndDte As Long, MyCount As Long, MNum As Long
Dim mystr As String
Set ws = Sheets("Sheet1") '  change to be your worksheet name
StDte = Date
EndDte = DateAdd("M", 4, Date)

lrow = ws.Cells(Rows.count, 1).End(xlUp).row
MNum = WorksheetFunction.CountA(Range("M:M"))

Set Rng = ws.Range("A1:M" & lrow)
ws.AutoFilterMode = False
Debug.Print Rng.address

Rng.AutoFilter Field:=10, Criteria1:=">=" & StDte, Operator:=xlAnd, Criteria2:="<=" & EndDte

If MNum <> 0 Then
    Rng.AutoFilter Field:=13, Criteria1:="<>Email"
Else
End If

MyCount = ws.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count

If MyCount > 1 Then

    For Each cel In ws.UsedRange.SpecialCells(xlCellTypeVisible).Columns(1).Cells
    
        If cel.row <> 1 Then
           ws.Cells(cel.row, "M") = "Email Sent"
        End If
    
    Next cel

ws.UsedRange.SpecialCells(xlCellTypeVisible).Resize(, 8).Copy

Dim Outlook As Object, newEmail As Object, xInspect As Object, pageEditor As Object
Dim wdformatplaintext As Long

Set Outlook = CreateObject("Outlook.Application")
Set newEmail = Outlook.CreateItem(0)

Set newEmail = Outlook.CreateItem(0)
    
    With newEmail
              
      .To = "CHANGE THIS TO YOUR RECIPIENT EMAIL ADDRESS" '  change as required
      .subject = "Defect Handovers Due"
      .ReadReceiptRequested = False
      .htmlbody = "Your defects handover date is due 4 months from today for" & "<br><br>"
      .display
      
        Set xInspect = newEmail.GetInspector
        Set pageEditor = xInspect.WordEditor
    
        pageEditor.Application.Selection.Start = Len(.htmlbody)
        pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
        pageEditor.Application.Selection.pasteandformat (wdformatplaintext)
        
      .display
      .htmlbody = .htmlbody & "<br><br>" & _
                  "Please action and contact client."
      
        Set pageEditor = Nothing
        Set xInspect = Nothing
        Application.CutCopyMode = False
   
      .display ' change this to .send once you are happy with the setup to auto send email
   End With
      
Else
End If
End Sub

 

[suet]

Hi Gordsky

Thank you very very much for the code above. I will give it a go and come back to you soon.

Once again many thanks for your help and support.

Regards
Sue

 

[suet]

Hi Gordsky

The code is working in that it generates the email but it copies everything from the spreadsheet into the email. It doesn't appear to filter just the records for Defects Date which are 4 months away.

It literally copies all the data into the email.

Anything else I can try?

Regards
Sue