Public Sub SendEmailbyList()
Dim iRows As Long, iCounter As Long, Att As String, mailBody As String, Subj As String
Dim i As Long, j As Long, mailUser As String, tStr As String, mailTo As String, tBL As Boolean
UserForm1.Hide
Sheets("SendEmail").Select
With Sheets("SendEmail")
iRows = .Range("A65536").End(xlUp).row
If iRows < 6 Then
MsgBox "No site list,check and try again": Exit Sub
End If
For i = 6 To iRows
mailUser = .Range("B" & i).Value
Finc = Sheets("SendEmail").Cells(i, 1).Value
Strc = Now
mailTo = .Range("C" & i).Value
Subj = "Month_End_Financial - " & Finc & " - " & "System Generate Testing File" & " - " & Strc
Subj = Finc & " - " & "ETB Excel File" & " - " & Strc
Att = .Range("D" & i).Value
mailBody = CemailBody(mailUser)
tBL = sendMails(mailTo, Subj, mailBody, Att)
Range("E" & i).Value = "Sent"
Next i
End With
MsgBox "Email Sent", vbInformation
End Sub
Public Function CemailBody(User As String) As String
Dim Body As String
Body = ""
Body = Body & "<DIV Style='font-size:10.0pt;font-family:Century Gothic;'>"
Body = Body & "Hi " & User & ",<br/><br/>"
Body = Body & "Please find attachment Extended Trial Balance (ETB), " & Finc
Body = Body & "Any question, Kindly contact the below Group ID for any Technical Support." _
& "<br/>" & "<br/>"
Body = Body & "<ul><li>" & "#IN - GBS CHE GL Tech Admin Team <in.gbschegltechadminteam@Gmail.com>" & "</ul></li>"
Body = Body & "Best Regards" & "<br/>"
Body = Body & "GL Tech Admin Team" & "<br/>"
Body = Body & "<p align=""center"">" & "<span style=""color:#80BFFF"">***Do not reply to this Email, This is an Auto-Generated Email***</span style=""color:#80BFFF""><br />"
Body = Body & "</DIV>"
CemailBody = Body
End Function
Public Function sendMails(strTo As String, strSubject As String, strBody As String, strFileName As String) As Boolean
On Error GoTo errHandle
Dim oOutlookApp As New Outlook.Application
Dim oItemMail As Outlook.MailItem
Set oItemMail = oOutlookApp.CreateItem(olMailItem)
On Error GoTo errHandle
With oItemMail
.SentOnBehalfOfName = Sheets("SendEmail").Cells(1, 8).Text
.To = strTo
.Subject = strSubject
.BodyFormat = olFormatHTML
.HTMLBody = strBody
If Len(strFileName) > 0 Then .Attachments.Add (strFileName)
.Sensitivity = olPersonal
.Display
End With
sendMails = True
Exit Function
errHandle:
SendMail = False
End Function