Automatically Sending Email

[webmax]

Hi

I have a attached email macro to send email through outlook.

In Addition to this if i sent the mail it should reflect the date in the H Coloum. For example if i send email today it should reflect as 09th Dec 2015 in the H Coloumn. And if the H Coloumn is filled or email already sent. The Email should not got again.

And also the same macro should run automatically on the specific time daily if i open this excel file. For example i want to run this macro daily at 11:00 am Daily and if the excel opens. If i open this excel at 11:30 it should run. The two condition should work.

regards
Shahul

 

[Chihiro]

To run your macro at 11:00 or if opened after 11:00.

Private Sub Workbook_Open()
If TimeValue(Now) > TimeValue("11:00:00") Then
    Call CreateMails
Else
    Application.OnTime TimeValue("11:00:00"), "CreateMails"
End If
End Sub

For the other portion. Change your code to...

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 And Sheet1.Cells(x + 2, 8) = "" 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
        Sheet1.Cells(x + 2, 8).Value = Date
        MsgBox "Mail Sent Successfully"
ElseIf Sheet1.Cells(x + 2, 8) <> "" Then
    MsgBox "Email already sent"
Else
    MsgBox "It is a Future Date"
End If
End With
Next x
End Sub

 

[webmax]

Thanks for the coding. I need additionally to find how many mails sent.

For example if i open the excel file. It automatically send two mails. In the Message should come as 2 Mails Sent successfully. I need the code for this.

 

[Chihiro]

Here you go.

Sub CreateMails()
On Error Resume Next
Dim aa As String
On Error Resume Next
Dim olx As Outlook.Application
Dim olItem As Outlook.MailItem
Dim lCount As Long
Set olx = New Outlook.Application
lCount = 0
For x = 1 To Sheet1.Range("A1").Value
Set olItem = olx.CreateItem(0)
With olItem
If Sheet1.Cells(x + 2, 7) <= Date And Sheet1.Cells(x + 2, 8) = "" 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
        lCount = lCount + 1
        .Send
        Sheet1.Cells(x + 2, 8).Value = Date
        'MsgBox "Mail Sent Successfully"
ElseIf Sheet1.Cells(x + 2, 8) <> "" Then
    'MsgBox "Email already sent"
Else
    'MsgBox "It is a Future Date"
End If
End With
Next x
MsgBox lCount & " Mail Sent Successfully"
End Sub

Basically you need counter to count each time If conditions are met and emails are sent. So set the variable lCount = 0, before the For Loop, and include counting operation lCount = lCount +1 after successful If Then and before Else