View Full Version : small logic is missing (auto mail)

01-19-2017, 06:05 PM

First of all, Sorry for my bad english.

With my basic knowledge I created vba code for sending auto mails. But in the code first if condition is not executing. i tried in different ways. but all are went in vain. Pls help me.

1) if employee status is "Resigned" ("Status" column mentioned in "Master" sheet) then mail should not go to that person.

2) if employee status is "Working" and there is no individual attachment for him, then mail should go with remaining all attachments (attachment file path's are mentioned in 'column F' in "Emp Information" Sheet).

3) if employee status is "Working" and there is individual attachment, then mail should go with remaining all attachments (attachment file paths mentioned in each individual cell in 'Column F' in "Emp Information" sheet) including individual attachment (attachment file path mentioned in each individual cell in 'Column F' in "Emp Information" sheet).


1)Employee's A1,A5,A9,A10,A15 are resigned. So they should not get email.
2) Employee A3 is Working and there is no file to attach for them (Column F in "Emp information" sheet). then Mail should go with remaining all attachments in column G in "Emp information" Sheet ("Covering letter.txt","1.txt")
3) for employees A2,A4,A6,A7,A8,A9,A11,A13,A14 , mail should go with all attachments (individual & remaining files)

I hope criteria's are clear.

Code is perfect except one error. if there are more than one resigned employees (A9 and A10 employees details are in a row in "Emp information" Sheet. They both are resigned. ) details came one by one, then error occurs.

i can't understand where the mistake was occurred in my code. Pls help me

Thank you in advance

01-23-2017, 01:05 PM

Sub vbax_58311_email_based_on_condition()

Dim i As Long, j As Long

Worksheets("Emp Information").Select

If Application.CountA(Columns(7)) > 1 Then
Range("G2:G" & Range("A" & Rows.Count).End(xlUp).Row).Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlYes
MsgBox "Please enter file full names to attach to emails to each working employee."
Exit Sub
End If
'to ensure there are file full names and no blank cells in col G. no need to interrupt the code and make the user do this.

With CreateObject("Outlook.Application")
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Range("C" & i).Value = "Working" Then
With .CreateItem(olMailItem)
.To = Range("B" & i).Value
.Subject = Range("D" & i).Value
.Body = Range("E" & i).Value
If Len(Range("F" & i)) > 0 Then .Attachments.Add Range("F" & i).Value
For j = 2 To Range("G" & Rows.Count).End(xlUp).Row
.Attachments.Add Range("G" & j).Value
Next j
End With
End If
Next i
End With

End Sub