Send data from Excel in email from specific email address
 

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

Send data from Excel in email from specific email address
 

Erik,

There may be a way to code this (I haven't found it), but the easiest way is to open Outlook and log
onto the Outlook account from which you want to send the emails prior to running the macro.

HTH,
Bernie
MS Excel MVP


"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

Send data from Excel in email from specific email address
 

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

Send data from Excel in email from specific email address
 

The only issue is that I am logged into all 3 accounts at once.

"Bernie Deitrick" wrote:

Erik,

There may be a way to code this (I haven't found it), but the easiest way is to open Outlook and log
onto the Outlook account from which you want to send the emails prior to running the macro.

HTH,
Bernie
MS Excel MVP


"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

Send data from Excel in email from specific email address
 

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

Send data from Excel in email from specific email address
 

Not use your code but one of the Outlook object model examples from my site
http://www.rondebruin.nl/sendmail.htm

With the line I posted

--

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


"Erik" wrote in message ...
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