Option Explicit

Private Declare Function ShellExecute Lib "Shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub Send1EMail()
 '-- was last used with worksheet Gods&Goddesses  2002-09-05
 '-- this macro was invoked by another macro that used/set
 '-- a send/sent/quit flag
    Dim Email As String, Subj As String
    Dim response As Variant
    Dim msg As String, url As String
    Email = Cells(ActiveCell.Row, 1)
    Subj = Cells(ActiveCell.Row, 2)
    msg = Cells(ActiveCell.Row, 3)
'--     Create the URL
    url = "mailto:" & Email & "?subject=" & Subj & "&body=" _
      & Replace(msg, Chr(10), "/" & vbCrLf & "\")
    MsgBox url
    url = Left(url, 2025) 'was successful with 2025   , not with 2045
'--     Execute the URL (start the email client)
     ShellExecute 0&, vbNullString, url, vbNullString, vbNullString, vbNormalFocus
 End Sub
 
 Sub mailto_Selection()
    'David McRitchie, 2005-08-01 modified for selection,
    '  http://www.mvps.org/dmcritchie/excel/email.htm
    Dim Email As String, Subj As String, cell As Range
    Dim response As Variant
    Dim msg As String, url As String
    Email = ""    'create list below
    Subj = "Family Newsletter"
    msg = "Dear Family,"
'--     Create the URL

     For Each cell In Selection
         Email = Email & cell.Text & "; "
     Next cell

    url = "mailto:" & Email & "?subject=" & Subj & "&body=" _
      & Replace(msg, Chr(10), "/" & vbCrLf & "\")
    MsgBox url
    url = Left(url, 2025) 'was successful with 2025   , not with 2045
'--     Execute the URL (start the email client)

  '--use the ShellExecute  for review before sending
    ShellExecute 0&, vbNullString, url, _
      vbNullString, vbNullString, vbNormalFocus
    
  '--use this code to send automatically
  '  ActiveWorkbook.FollowHyperlink (url)
  '  Application.Wait (Now + TimeValue("0:00:03"))
  '  Application.SendKeys "%s"
 End Sub