When using the following code I'm getting runtime error 13 type mismatch highlighting the line,
Code: Select all
If cell.Offset(0, 6).Value = DateAdd("m", 1, Date) Then
Code: Select all
Sub SendReminderEmail()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim senderEmail As String
senderEmail = "your-email@example.com"
' Set the worksheet where the data is stored
Set ws = ThisWorkbook.Sheets("Sheet1")
' Set the range of cells containing the data
Set rng = ws.Range("A2:H" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
' Loop through each row in the range
For Each cell In rng.Rows
' Check if the expiry date is 1 month from today
If cell.Offset(0, 6).Value = DateAdd("m", 1, Date) Then
' Create Outlook application object
Set OutlookApp = CreateObject("Outlook.Application")
' Create a new email
Set OutlookMail = OutlookApp.CreateItem(0)
' Set email properties
With OutlookMail
.SentOnBehalfOfName = senderEmail
.To = cell.Offset(0, 7).Value
.Subject = "Certificate Expiry Reminder"
.Body = "Dear " & cell.Offset(0, 3).Value & "," & vbCrLf & vbCrLf & _
"This is a reminder that your document (" & cell.Offset(0, 2).Value & ") is expiring on " & cell.Offset(0, 6).Value & ". Please renew." & vbCrLf & vbCrLf & _
"Best regards," & vbCrLf & _
"Your Name"
.Display
End With
' Clean up
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End If
Next cell
End Sub
for example I enter expiry date in column G in the format 9/12/2023 which then the code would send an email to the customer informing one month is left to expire.