Sub SendEmailViaOutlookExpress()
  Dim cell As Range
  Dim Subj As String
  Dim EmailAddr As String
  Dim Recipient As String
  Dim Bonus As String
  Dim Msg As String
  Dim HLink As String
  For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "*@*" Then
      'Get the data
      Subj = "Your Annual Bonus"
      Recipient = cell.Offset( 0 , - 1 ).Value
      EmailAddr = cell.Value
      Bonus = Format(cell.Offset( 0 ,  1 ).Value, "$0,000.")
            
     'Compose message
      Msg = "Dear " & Recipient & "%0A"
      Msg = Msg & "%0A" & "I am pleased to inform you that your annual bonus is "
      Msg = Msg & Bonus & "%0A"
      Msg = Msg & "%0A" & "William Rose"
      Msg = Msg & "%0A" & "President"
            
      'Build hyperlink
      HLink = "mailto:" & EmailAddr & "?"
      HLink = HLink & "subject=" & Subj & "&"
      HLink = HLink & "body=" & Msg
      'Send it
      ActiveWorkbook.FollowHyperlink HLink
      Application.Wait (Now + TimeValue("0:00:01"))
      SendKeys "%s", True
    End If
  Next
End Sub