Automatically send mail in outlook on specific date

[webmax]

Hi

I have create a macro for sending email but i need the macro code to send the mail in a specifi date which i mentioned in column 6.

Below the macro code i have already have i need to add this logic as specific date.

.To = Sheet1.Cells(x + 2, 1).Value
.CC = Sheet1.Cells(x + 2, 2).Value
.BCC = Sheet1.Cells(x + 2, 3).Value
.Subject = Sheet1.Cells(x + 2, 4).Value
.Body = Sheet1.Cells(x + 2, 5).Value

Regards
Shahul

 

[Chihiro]

So what you need to do is when you run the code it has to check Col6 value against Today's date.

So... something like.

IF Sheet1.Cells(x +2, 6) = Date Then
'Your send email code
Else
'stop code?
End If

In VBA Date is same as Today()

 

[webmax]

Hi

I tried the above code but if i enter the future Date the email is going. I need the email should go only if the date is current date.

I am attaching the excel for your reference.

Regards
Shahul

 

[Chihiro]

You've got the code in wrong place....
It should look like following.

Sub CreateMails()
On Error Resume Next
Dim aa As String
On Error Resume Next
Dim olx As Outlook.Application
Dim olItem As Outlook.MailItem
Set olx = New Outlook.Application
For x = 1 To Sheet1.Range("A1").Value
Set olItem = olx.CreateItem(0)

With olItem
If Sheet1.Cells(x + 2, 7) = Date Then
    .To = Sheet1.Cells(x + 2, 1).Value
    .CC = Sheet1.Cells(x + 2, 2).Value
    .BCC = Sheet1.Cells(x + 2, 3).Value
    .Subject = Sheet1.Cells(x + 2, 4).Value
    .Body = Sheet1.Cells(x + 2, 5).Value
        aa = Sheet1.Cells(x + 2, 6).Value
        For y = 1 To Countgk(Sheet1.Cells(x + 2, 6).Value) + 1
        If Countgk(aa) <> 0 Then
        Posx = WorksheetFunction.Find(",", aa)
        xx = Left(aa, Posx - 1)
        .Attachments.Add xx
        aa = Replace(aa, xx & ",", "", 1)
        Else
        '.Attachments.Add aa
        End If
        Next y
   
        .Send
        MsgBox "Mail Sent Successfully"
Else
    MsgBox "Date is not equal to date in column 7"
End If
End With
Next x

End Sub