Private Sub cmdOK_Click()
On Error Resume Next
Dim wsReport As Worksheet
Dim BodyText As String
Dim rwReport As Integer, rwI As Integer
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Set wsReport = ThisWorkbook.Sheets("Sheet2")
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
rwReport = 1
Do While wsReport.Cells(rwReport, 1) <> "" Or wsReport.Cells(rwReport, 5) <> ""
If wsReport.Cells(rwReport, 3) = "" Then
wsReport.Cells(rwReport, 4).Font.Bold = True
Else
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
'Set the recipient for the new email
.To = wsReport.Cells(rwReport, 3)
.Subject = "AY Annual Report 2005 information required"
BodyText = "Dear " & wsReport.Cells(rwReport, 1) & vbCr _
& "Greetings from #### ####, New Delhi!" & vbCr _
& "Please find below the list of languages/programmes for which we have not yet received the annual letter response monthwise report for 2005. Please do send the same at the earliest. If you have already sent the mail, please forward it again to ########.###" & vbCr
BodyText = BodyText & ">" & wsReport.Cells(rwI, 5) & vbCr
rwI = rwReport + 1
Do While wsReport.Cells(rwI, 1) = "" And wsReport.Cells(rwI, 5) <> ""
BodyText = BodyText & ">" & wsReport.Cells(rwI, 5) & vbCr
rwI = rwI + 1
Loop
rwReport = rwI - 1
BodyText = BodyText & vbCr & "Thanking you." & vbCr _
& "Yours Sincerely," & vbCr & vbCr & "Jeba Singh Emmanuel" _
& vbCr & "Assistant Media Director, Radio AY"
.Body = BodyText
.Send
End With
End If
rwReport = rwReport + 1
Loop
If bStarted Then
'If we started Outlook from code, then close it
oOutlookApp.Quit
End If
Set oItem = Nothing
Set oOutlookApp = Nothing
Unload Me
End Sub