[FONT=Courier New][COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Declare[/COLOR] [COLOR=darkblue]Function[/COLOR] ShellExecute [COLOR=darkblue]Lib[/COLOR] "shell32.dll" _
Alias "ShellExecuteA" ([COLOR=darkblue]ByVal[/COLOR] hwnd [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], [COLOR=darkblue]ByVal[/COLOR] lpOperation [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
ByVal lpFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], [COLOR=darkblue]ByVal[/COLOR] lpParameters [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], [COLOR=darkblue]ByVal[/COLOR] lpDirectory [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
ByVal nShowCmd [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]) [COLOR=darkblue]As[/COLOR] Long
[COLOR=darkblue]Sub[/COLOR] SendEMail()
[COLOR=darkblue]Dim[/COLOR] Email [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], Subj [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
[COLOR=darkblue]Dim[/COLOR] Msg [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], URL [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
[COLOR=darkblue]Dim[/COLOR] r [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR], x [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Double[/COLOR]
[COLOR=darkblue]For[/COLOR] r = 2 [COLOR=darkblue]To[/COLOR] 4 [COLOR=green]'data in rows 2-4[/COLOR]
[COLOR=green]' Get the email address[/COLOR]
Email = Cells(r, 2)
[COLOR=green]' Message subject[/COLOR]
Subj = "Your Annual Bonus"
[COLOR=green]' Compose the message[/COLOR]
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "I am pleased to inform you that your annual bonus is "
Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "William Rose" & vbCrLf
Msg = Msg & "President"
[COLOR=green]' Replace spaces with %20 (hex)[/COLOR]
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
[COLOR=green]' Replace carriage returns with %0D%0A (hex)[/COLOR]
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
[COLOR=green]' Create the URL[/COLOR]
URL = "mailto:" & Email & "?subject=" & [COLOR=darkblue]Sub[/COLOR]j & "&body=" & Msg
[COLOR=green]' Execute the URL (start the email client)[/COLOR]
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
[COLOR=green]' Wait two seconds before sending keystrokes[/COLOR]
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
[COLOR=darkblue]Next[/COLOR] r
[COLOR=darkblue]End[/COLOR] Sub[/FONT]