CODEWITHSUNDEEP
vbaexcel
astha
astha

Reputation: 115

Send mail if date in cell is 2 years older than the current date

I have created a macro which lists the name, path, Creation date, modification date of all the files and subfolders in an excel worksheet, this macro is working absolutely fine.

However now I want to create a macro which can check the entire list of files and folders and if the Date creation date (Column F ) of any listed files/folders is greater than 2 years from the current date, it should send an automated mail giving the name of the file, its path and the creation and modification information (basically copy all the information of that particular row) to me.

Please find below the code in which I am getting the error (Run time Error) on this line :

Sub send_files()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
Dim sDate As String

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set sh = ThisWorkbook.Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
sDate = Date

For Each cell In sh.Columns("F").Cells
    Days = DateDiff("yyyy", Cells.Value, sDate)
    If Days > 2 Then
                Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .to = cell.Value
            .Subject = "Testfile"
            .Body = "Hi " & cell.Offset(0, -1).Value
            .send

        End With
    End If
Next cell

Set OutApp = Nothing
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

The error occurs on:

Days = DateDiff("yyyy", Cells.Value, sDate)

Can anyone assist with this error?

Upvotes: 2

Views: 101

Answers (1)

CLR
CLR

Reputation: 12279

Try changing 

Days = DateDiff("yyyy", Cells.Value, sDate)

to

Days = DateDiff("yyyy", cell.Value, sDate)

Upvotes: 4

Related Questions