Sub SendEmail()
'Uses early binding

 
Dim OutlookApp As Object
Dim MItem As Object
Dim Today As Object
Dim cell As Range
Dim Subj As Variant
Dim EmailAddr As String
Dim Scie As String
Dim CnNo As String
Dim Msg As String
 
 
'Create Outlook Object
On Error GoTo debugs
Set OutlookApp = CreateObject("Outlook.Application")
Set Today = cell.Value("C1")
'Loop through the rows
For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
  With cell.Value = Today
  'Get the data
  Subj = "Please check the CN Tracker, a CN has been assigned to you "
  Scie = cell.Offset(0, 8).Value
  EmailAddr = cell.Offset(0, 9).Value
  CnNo = Format(cell.Offset(0, -3).Value, "0,000.")
 
  'Compose message
  Msg = "Dear " & Scie & vbCrLf & vbCrLf
  Msg = Msg & "CN " & CnNo & " has been assigned to you. " & vbCrLf & vbCrLf
  Msg = Msg & "Please check the CN tracker and request the technical solution and supplier contact information from the responsible engineer. " & vbCrLf & vbCrLf
  Msg = Msg & "Have a great day. " & vbCrLf & vbCrLf
  Msg = Msg & " " & vbCrLf & vbCrLf
  Msg = Msg & " " & vbCrLf & vbCrLf
  Msg = Msg & "************This is an automated message, please do not reply. **************"
 
  'Create Mail Item and send it
  Set MItem = OutlookApp.CreateItem(olMailItem)
  With MItem
   .To = EmailAddr
   .Subject = Subj
   .Body = Msg
   .Send
     End With
 
debugs:
If Err.Description <> "" Then MsgBox Err.Description
 
 
Next
End If
 
End Sub
 
 
Private Sub CommandButton1_Click()
Sheet1.SendEmail
End Sub