I have tried and I get no error, but it doesn't work. I need to add
something to the URL = line so that from field it's included in the email. I
just don't know what the code for the URL = line is so that the from line is
entered into the email.

"Ron de Bruin" wrote:

Hi erik

If you use Outlook or CDO it is Possible

See the Outlook examples on my site and read the tips for Outlook on this page
http://www.rondebruin.nl/mail/tips2.htm

'The receiver can see the original mail address in the properties if he want
..SentOnBehalfOfName = """SenderName"" "

Or look on the CDO page
http://www.rondebruin.nl/cdo.htm


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Erik" wrote in message ...
This macro does exactly what I need with the exception of one thing. I have
multiple email addresses that I have permission to send from and I need it to
come from one specific email address. I have tried adding Dim From As String
and From = " but this does not seem to work. It seems like
I need to add something to URL = line but I am not sure what it is that I
need to add. What do I need to add to this macro is to be able to set the
from field of the email to a specific email address/email account?

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 SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
For r = 2 To 4 'data in rows 2-4
' Get the email address
Email = Cells(r, 2)

' Message subject
Subj = "Your Annual Bonus"

' Compose the message
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"

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf,
"%0D%0A")

' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString,
vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next r
End Sub