Sending an automatic email when the due date is approaching

[KTSARA]

Hello experts,
I am quite new to VBA. Currently, I am working on a project where I want to send an automatic email seven days before the due date notifying that the due date is approaching. I want to get the date and the respective email address from two different sheets. I searched for other threads to find a code, but couldn't find an exact match. So, I modified a code I found in the internet a little, but I get an error message. It will be a great help if anyone of you could help me to find a way to correct that error.

Here is the code that I am using :

Option Explicit
Sub email()

Dim r As Range
Dim cell As Range

Set r = Range("U2:U10000")

For Each cell In r
If cell.Value = Date + 7 Then

        Dim Email_Subject, Email_Send_From, Email_Send_To, _
        Email_Cc, Email_Body As String
        Dim Mail_Object, Mail_Single As Variant
        Dim Machine_Code As Long
        Dim Machine_Type As Long

        Machine_Code = Application.WorksheetFunction.VLookup(cell.Value, Range("A:U"), 21, False)
        Machine_Type = Application.WorksheetFunction.VLookup(Machine_Code, Sheet1.Range("B:C"), 1, False)

        Email_Subject = "Service Reminder"
        Email_Send_From = "k******@*******"
        Email_Send_To = Application.WorksheetFunction.VLookup(Machine_Code, Sheet1.Range("C:M"), 11, False)
        'Email_Cc = "D@******.com"
        Email_Body = "There is a Service scheduled for a" & Machine_Type & "on" & cell.Value

        On Error GoTo debugs
        Set Mail_Object = CreateObject("Outlook.Application")
        Set Mail_Single = Mail_Object.CreateItem(0)
        With Mail_Single
        .Subject = Email_Subject
        .To = Email_Send_To
        .cc = Email_Cc
        .Body = Email_Body
        .send
        End With

    End If
    Next


   Exit Sub

debugs:
    If Err.Description <> "" Then MsgBox Err.Description
  End Sub

This is my workbook

This is the error message I get once I run the above code:

Thanks a lot in advance

 

[Sunjinsak]

Hi @KTSARA

Assuming you haven't already fixed this by now...

On the surface it looks like it might be a problem with range selection. To narrow it down try commenting out the following line:

On Error GoTo debugs

Run your code again and you should receive the same error but now there will be a 'Debug' button available. If you click that it should highlight the line of code causing the issue. Post back here with the result and we should be able to shed more light on it for you.

 

[KTSARA]

Hi @KTSARA

Assuming you haven't already fixed this by now...

On the surface it looks like it might be a problem with range selection. To narrow it down try commenting out the following line:

On Error GoTo debugs

Run your code again and you should receive the same error but now there will be a 'Debug' button available. If you click that it should highlight the line of code causing the issue. Post back here with the result and we should be able to shed more light on it for you.

Hello Sunjinsak,
Many thanks for taking your valuable time to reply my question. I changed the way I was planning to send emails. Now I have a separate sheet with machine code, service date,email address, and a column to mark whether alert was sent or not.
Now what i want to do is, identify the machines with service date approaching (7 days before the service date) and send an email to the particular email address next to the service date. Then I want to update the Alert column with "sent" or "not sent".

This is the code I am using and this gives me a "Run-time error '13'- Type mismatch" message. If you experts can help me to understand the error, it would be much appreciated.

Option Explicit

Sub email()

    Dim r As Range
    Dim cell As Range

    Set r = Range("C2:C30150")

    For Each cell In r

        If cell.Value = Date + 7 Then

            Dim Email_Subject, Email_Send_From, Email_Send_To, _
            Email_Body As String
            Dim Mail_Object, Mail_Single As Variant

            Email_Subject = "Service Reminder"
            Email_Send_From = "k.t.s@a.world"
            Email_Send_To = Application.WorksheetFunctin.VLookup(cell.Value, "B:C", 2, False)
            'Email_Cc = "bob@bob.com"
            'Email_Bcc = "bob@bob.com"
            Email_Body = "There is a service scheduled for" & cell.Value

            'On Error GoTo debugs
            Set Mail_Object = CreateObject("Outlook.Application")
            Set Mail_Single = Mail_Object.CreateItem(0)
            With Mail_Single
            .Subject = Email_Subject
            .To = Email_Send_To
            '.cc = Email_Cc
            '.BCC = Email_Bcc
            .Body = Email_Body
            .send
            End With

        End If

    Next


    Exit Sub

debugs:
        If Err.Description <> "" Then MsgBox Err.Description
End Sub

Thanks a lot in advance

 

[Sunjinsak]

What line is highlighted by the debugger when you receive that error message?

There are a lot of cells in the range "C2:C30150". Do all of them contain dates in a valid date format? If not that may be your problem.

It could also be that the line Application.WorksheetFunctin.VLookup(cell.Value, "B:C", 2, False) is returning something other than a string. Just to test, comment out that line and replace it with an actual string. E.g...

Email_Send_To = "test@test.com"

Warning: You should also, just for the sake of initial testing, change your range to, say, just "C2:C5" for example (and manually change the data in the range if necessary) and also change the .send in the With block to .display instead. Like so...

With Mail_Single
    .Subject = Email_Subject
    .To = Email_Send_To
    '.cc = Email_Cc
    '.BCC = Email_Bcc
    .Body = Email_Body
    .display
End With

Changing the range will stop potentially thousands of unnecessary emails being created and using .display will merely display any that are created rather than automatically sending them - which you probably don't want to do whilst testing.

 

[KTSARA]

What line is highlighted by the debugger when you receive that error message?

There are a lot of cells in the range "C2:C30150". Do all of them contain dates in a valid date format? If not that may be your problem.

It could also be that the line Application.WorksheetFunctin.VLookup(cell.Value, "B:C", 2, False) is returning something other than a string. Just to test, comment out that line and replace it with an actual string. E.g...

Email_Send_To = "test@test.com"

Warning: You should also, just for the sake of initial testing, change your range to, say, just "C2:C5" for example (and manually change the data in the range if necessary) and also change the .send in the With block to .display instead. Like so...

With Mail_Single
    .Subject = Email_Subject
    .To = Email_Send_To
    '.cc = Email_Cc
    '.BCC = Email_Bcc
    .Body = Email_Body
    .display
End With

Changing the range will stop potentially thousands of unnecessary emails being created and using .display will merely display any that are created rather than automatically sending them - which you probably don't want to do whilst testing.

Hello,
Thanks a lot for taking time to answer my question. I replaced the range with a smaller range and replaced the VLOOKUP line with an email address, but still it is not working and it doesn't highlight a line as well.

 

[Sunjinsak]

When you say it is still not working, are you still receiving the 'Type mismatch' error? If so what line is triggering that error? You can step through each line of your code one at a time by pressing F8 in the editor. Doing that may help track down where it's going wrong.

If you're not receiving any error message and it's just "not working" then it could be a logic error. Remember that the line...

If cell.Value = Date + 7 Then

...will just jump to the 'End If' statement, followed immediately by 'End Sub' if the condition doesn't evaluate to true. If you've shortened the range for testing but not altered the data in that range to force this line to evaluate to true then your code won't get executed. Is this what you mean by "not working"? If so it's actually working correctly - it's just maybe not what you're expecting to happen. Stepping though line-by-line using F8 will help you see the flow of execution.

Edit: just to add; the code you're using to actually create the email is working just fine in isolation (e.g. outside of the 'For/Next' and 'If/End If' blocks). The only bits I've changed for the sake of testing is to replace the VLOOKUP with a hard-coded string, and removed the '& cell.Value' from the end of the Email_Body string. This would strongly suggest your 'Type mismatch' problem lies either with whatever the VLOOKUP is returning, or with one or more of the "dates" in the C column of your worksheet.