Repost

T

Tim

Sorry, I posted this yesterday but didn't get a response. I was hoping to try
again today.

I’m having a problem trying to figure out why one email function works but
another one doesn’t. Both codes work on my home computer using Outlook, but
when I try to run them at work(we use Lotus Notes) the Sub
Mail_Text_in_Body_3() code does not create the message. It seems like it is
calling up Lotus Notes but the email message doesn’t get created. I have
changed the mail server to Lotus Notes in Internet Explorer.
The code Mail_ActiveSheet() works fine


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 Mail_Text_in_Body_3()
'Creates statement for a person and emails it to data entry
Dim msg As String, URL As String
Dim Recipient As String, Subj As String
Dim cell As Range
Recipient = "data"

Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & "
for Incident " & Sheets("Employee List").Range("N7").Value

msg = "Statement of " & Sheets("Employee List").Range("Q1").Value & " of
My Work" & vbNewLine & vbNewLine
For Each cell In Sheets("Employee List").Range("N3")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")

msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
URL = "mailto:" & Recipient & "&subject=" & Subj & "&body=" & msg
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString,
vbNormalFocus
Application.Wait (Now + TimeValue("0:00:08"))
Application.SendKeys "%s"
End Sub




Sub Mail_ActiveSheet()
Dim strdate As String
Dim FName1, FName2, Fullname
FName1 = Range("AU2").Value & "-"
FName2 = Range("J4").Value
Fullname = FName1 & FName2
ActiveSheet.Copy
strdate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
ActiveSheet.SaveAs "Sheet1 " & Fullname _
& " " & strdate & ".xls"
ActiveWorkbook.SendMail "data", _
Fullname
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.Fullname
ActiveWorkbook.Close False
End Sub
 
D

Dave Patrick

Another option.

http://www.paulsadowski.com/WSH/cdo.htm

--
Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

:
| Sorry, I posted this yesterday but didn't get a response. I was hoping to
try
| again today.
|
| I'm having a problem trying to figure out why one email function works but
| another one doesn't. Both codes work on my home computer using Outlook,
but
| when I try to run them at work(we use Lotus Notes) the Sub
| Mail_Text_in_Body_3() code does not create the message. It seems like it
is
| calling up Lotus Notes but the email message doesn't get created. I have
| changed the mail server to Lotus Notes in Internet Explorer.
| The code Mail_ActiveSheet() works fine
|
|
| 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 Mail_Text_in_Body_3()
| 'Creates statement for a person and emails it to data entry
| Dim msg As String, URL As String
| Dim Recipient As String, Subj As String
| Dim cell As Range
| Recipient = "data"
|
| Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & "
| for Incident " & Sheets("Employee List").Range("N7").Value
|
| msg = "Statement of " & Sheets("Employee List").Range("Q1").Value & "
of
| My Work" & vbNewLine & vbNewLine
| For Each cell In Sheets("Employee List").Range("N3")
| msg = msg & vbNewLine & cell
| Next cell
| msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")
|
| msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
| URL = "mailto:" & Recipient & "&subject=" & Subj & "&body=" & msg
| ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString,
| vbNormalFocus
| Application.Wait (Now + TimeValue("0:00:08"))
| Application.SendKeys "%s"
| End Sub
|
|
|
|
| Sub Mail_ActiveSheet()
| Dim strdate As String
| Dim FName1, FName2, Fullname
| FName1 = Range("AU2").Value & "-"
| FName2 = Range("J4").Value
| Fullname = FName1 & FName2
| ActiveSheet.Copy
| strdate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
| ActiveSheet.SaveAs "Sheet1 " & Fullname _
| & " " & strdate & ".xls"
| ActiveWorkbook.SendMail "data", _
| Fullname
| ActiveWorkbook.ChangeFileAccess xlReadOnly
| Kill ActiveWorkbook.Fullname
| ActiveWorkbook.Close False
| End Sub
|
|
 
R

Ron de Bruin

More Excel examples for CDO are here
http://www.rondebruin.nl/cdo.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl


Dave Patrick said:
Another option.

http://www.paulsadowski.com/WSH/cdo.htm

--
Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

:
| Sorry, I posted this yesterday but didn't get a response. I was hoping to
try
| again today.
|
| I'm having a problem trying to figure out why one email function works but
| another one doesn't. Both codes work on my home computer using Outlook,
but
| when I try to run them at work(we use Lotus Notes) the Sub
| Mail_Text_in_Body_3() code does not create the message. It seems like it
is
| calling up Lotus Notes but the email message doesn't get created. I have
| changed the mail server to Lotus Notes in Internet Explorer.
| The code Mail_ActiveSheet() works fine
|
|
| 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 Mail_Text_in_Body_3()
| 'Creates statement for a person and emails it to data entry
| Dim msg As String, URL As String
| Dim Recipient As String, Subj As String
| Dim cell As Range
| Recipient = "data"
|
| Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & "
| for Incident " & Sheets("Employee List").Range("N7").Value
|
| msg = "Statement of " & Sheets("Employee List").Range("Q1").Value & "
of
| My Work" & vbNewLine & vbNewLine
| For Each cell In Sheets("Employee List").Range("N3")
| msg = msg & vbNewLine & cell
| Next cell
| msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")
|
| msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
| URL = "mailto:" & Recipient & "&subject=" & Subj & "&body=" & msg
| ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString,
| vbNormalFocus
| Application.Wait (Now + TimeValue("0:00:08"))
| Application.SendKeys "%s"
| End Sub
|
|
|
|
| Sub Mail_ActiveSheet()
| Dim strdate As String
| Dim FName1, FName2, Fullname
| FName1 = Range("AU2").Value & "-"
| FName2 = Range("J4").Value
| Fullname = FName1 & FName2
| ActiveSheet.Copy
| strdate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
| ActiveSheet.SaveAs "Sheet1 " & Fullname _
| & " " & strdate & ".xls"
| ActiveWorkbook.SendMail "data", _
| Fullname
| ActiveWorkbook.ChangeFileAccess xlReadOnly
| Kill ActiveWorkbook.Fullname
| ActiveWorkbook.Close False
| End Sub
|
|
Click to expand...
 
T

Tim

I think I tracked down the problem, too many characters. If I change "N8" to
a cell with less characters in it, it will work.
Any work around?

Thanks


Sub Mail_Text_in_Body()

Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""

Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & "
for Incident " & Sheets("Employee List").Range("P3").Value

msg = "Dear customer" & vbNewLine & vbNewLine
For Each cell In Sheets("Employee List").Range("N8")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")

msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc="
& Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg

ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:05"))
Application.SendKeys "%s"
End Sub
 
R

Ron de Bruin

Hi Tim

http://www.rondebruin.nl/mail/oebody.htm
you can read about the limit on this page

Do you only use Outlook Express ?


--
Regards Ron de Bruin
http://www.rondebruin.nl


Tim said:
I think I tracked down the problem, too many characters. If I change "N8" to
a cell with less characters in it, it will work.
Any work around?

Thanks


Sub Mail_Text_in_Body()

Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""

Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & "
for Incident " & Sheets("Employee List").Range("P3").Value

msg = "Dear customer" & vbNewLine & vbNewLine
For Each cell In Sheets("Employee List").Range("N8")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")

msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc="
& Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg

ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:05"))
Application.SendKeys "%s"
End Sub



Dave Patrick said:
Nice. Thank you Ron

--
Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

:
| More Excel examples for CDO are here
| http://www.rondebruin.nl/cdo.htm
|
|
| --
| Regards Ron de Bruin
| http://www.rondebruin.nl
Click to expand...
Click to expand...
 
T

Tim

We use Lotus Notes at work.

Ron de Bruin said:
Hi Tim

http://www.rondebruin.nl/mail/oebody.htm
you can read about the limit on this page

Do you only use Outlook Express ?


--
Regards Ron de Bruin
http://www.rondebruin.nl


Tim said:
I think I tracked down the problem, too many characters. If I change "N8" to
a cell with less characters in it, it will work.
Any work around?

Thanks


Sub Mail_Text_in_Body()

Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""

Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & "
for Incident " & Sheets("Employee List").Range("P3").Value

msg = "Dear customer" & vbNewLine & vbNewLine
For Each cell In Sheets("Employee List").Range("N8")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")

msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc="
& Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg

ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:05"))
Application.SendKeys "%s"
End Sub



Dave Patrick said:
Nice. Thank you Ron

--
Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

:
| More Excel examples for CDO are here
| http://www.rondebruin.nl/cdo.htm
|
|
| --
| Regards Ron de Bruin
| http://www.rondebruin.nl
Click to expand...
Click to expand...
Click to expand...
 
R

Ron de Bruin

We use Lotus Notes at work.

That's not good<g>

Have you try CDO

--
Regards Ron de Bruin
http://www.rondebruin.nl


Tim said:
We use Lotus Notes at work.

Ron de Bruin said:
Hi Tim

http://www.rondebruin.nl/mail/oebody.htm
you can read about the limit on this page

Do you only use Outlook Express ?


--
Regards Ron de Bruin
http://www.rondebruin.nl


Tim said:
I think I tracked down the problem, too many characters. If I change "N8" to
a cell with less characters in it, it will work.
Any work around?

Thanks


Sub Mail_Text_in_Body()

Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""

Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & "
for Incident " & Sheets("Employee List").Range("P3").Value

msg = "Dear customer" & vbNewLine & vbNewLine
For Each cell In Sheets("Employee List").Range("N8")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")

msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc="
& Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg

ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:05"))
Application.SendKeys "%s"
End Sub



:

Nice. Thank you Ron

--
Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

:
| More Excel examples for CDO are here
| http://www.rondebruin.nl/cdo.htm
|
|
| --
| Regards Ron de Bruin
| http://www.rondebruin.nl
Click to expand...
Click to expand...
Click to expand...
 
T

Tim

No I haven't. This what I am running. It works as long as cell N10 is less
than 120 characters.

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 Mail_Text_in_Body_3()
'Example for Outlook Express with API call
'In Excel 2002 I can use around 1800 characters
Dim msg As String, URL As String
Dim Recipient As String, Subj As String
Dim Recipientcc As String, Recipientbcc As String
Dim cell As Range
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""
'You can use a cell value also like this
'Recipient = Sheets("mysheet").Range("A1").Value
Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & "
for Incident " & Sheets("Employee List").Range("N7").Value
'Subj = Sheets("mysheet").Range("A2").Value
msg = "Statement for " & Sheets("Employee List").Range("Q1").Value
For Each cell In Sheets("Employee List").Range("N10")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")
'If you have hard returns in one of your cells you also need this line
(Tip from Keepitcool)
msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
URL = "mailto:" & Recipient & "?cc=" & Recipientcc & "&bcc=" &
Recipientbcc _
& "&subject=" & Subj & "&body=" & msg
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString,
vbNormalFocus
Application.Wait (Now + TimeValue("0:00:03"))
Application.SendKeys "%s"
End Sub



Ron de Bruin said:
We use Lotus Notes at work.
Click to expand...

That's not good<g>

Have you try CDO

--
Regards Ron de Bruin
http://www.rondebruin.nl


Tim said:
We use Lotus Notes at work.

Ron de Bruin said:
Hi Tim

http://www.rondebruin.nl/mail/oebody.htm
you can read about the limit on this page

Do you only use Outlook Express ?


--
Regards Ron de Bruin
http://www.rondebruin.nl


I think I tracked down the problem, too many characters. If I change "N8" to
a cell with less characters in it, it will work.
Any work around?

Thanks


Sub Mail_Text_in_Body()

Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""

Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & "
for Incident " & Sheets("Employee List").Range("P3").Value

msg = "Dear customer" & vbNewLine & vbNewLine
For Each cell In Sheets("Employee List").Range("N8")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")

msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc="
& Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg

ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:05"))
Application.SendKeys "%s"
End Sub



:

Nice. Thank you Ron

--
Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

:
| More Excel examples for CDO are here
| http://www.rondebruin.nl/cdo.htm
|
|
| --
| Regards Ron de Bruin
| http://www.rondebruin.nl
Click to expand...
Click to expand...
Click to expand...
 
T

Tim

I haven't been able to figure out CDO.

Ron de Bruin said:
We use Lotus Notes at work.
Click to expand...

That's not good<g>

Have you try CDO

--
Regards Ron de Bruin
http://www.rondebruin.nl


Tim said:
We use Lotus Notes at work.

Ron de Bruin said:
Hi Tim

http://www.rondebruin.nl/mail/oebody.htm
you can read about the limit on this page

Do you only use Outlook Express ?


--
Regards Ron de Bruin
http://www.rondebruin.nl


I think I tracked down the problem, too many characters. If I change "N8" to
a cell with less characters in it, it will work.
Any work around?

Thanks


Sub Mail_Text_in_Body()

Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""

Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & "
for Incident " & Sheets("Employee List").Range("P3").Value

msg = "Dear customer" & vbNewLine & vbNewLine
For Each cell In Sheets("Employee List").Range("N8")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")

msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc="
& Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg

ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:05"))
Application.SendKeys "%s"
End Sub



:

Nice. Thank you Ron

--
Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

:
| More Excel examples for CDO are here
| http://www.rondebruin.nl/cdo.htm
|
|
| --
| Regards Ron de Bruin
| http://www.rondebruin.nl
Click to expand...
Click to expand...
Click to expand...
 
R

Ron de Bruin

Hi Tim

Never test it with so many characters in a cell
Excel is not a Word editor<vbg>

Will look at it this weekend

--
Regards Ron de Bruin
http://www.rondebruin.nl


Tim said:
No I haven't. This what I am running. It works as long as cell N10 is less
than 120 characters.

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 Mail_Text_in_Body_3()
'Example for Outlook Express with API call
'In Excel 2002 I can use around 1800 characters
Dim msg As String, URL As String
Dim Recipient As String, Subj As String
Dim Recipientcc As String, Recipientbcc As String
Dim cell As Range
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""
'You can use a cell value also like this
'Recipient = Sheets("mysheet").Range("A1").Value
Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & "
for Incident " & Sheets("Employee List").Range("N7").Value
'Subj = Sheets("mysheet").Range("A2").Value
msg = "Statement for " & Sheets("Employee List").Range("Q1").Value
For Each cell In Sheets("Employee List").Range("N10")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")
'If you have hard returns in one of your cells you also need this line
(Tip from Keepitcool)
msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
URL = "mailto:" & Recipient & "?cc=" & Recipientcc & "&bcc=" &
Recipientbcc _
& "&subject=" & Subj & "&body=" & msg
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString,
vbNormalFocus
Application.Wait (Now + TimeValue("0:00:03"))
Application.SendKeys "%s"
End Sub



Ron de Bruin said:
We use Lotus Notes at work.
Click to expand...

That's not good<g>

Have you try CDO

--
Regards Ron de Bruin
http://www.rondebruin.nl


Tim said:
We use Lotus Notes at work.

:

Hi Tim

http://www.rondebruin.nl/mail/oebody.htm
you can read about the limit on this page

Do you only use Outlook Express ?


--
Regards Ron de Bruin
http://www.rondebruin.nl


I think I tracked down the problem, too many characters. If I change "N8" to
a cell with less characters in it, it will work.
Any work around?

Thanks


Sub Mail_Text_in_Body()

Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""

Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & "
for Incident " & Sheets("Employee List").Range("P3").Value

msg = "Dear customer" & vbNewLine & vbNewLine
For Each cell In Sheets("Employee List").Range("N8")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")

msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc="
& Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg

ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:05"))
Application.SendKeys "%s"
End Sub



:

Nice. Thank you Ron

--
Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

:
| More Excel examples for CDO are here
| http://www.rondebruin.nl/cdo.htm
|
|
| --
| Regards Ron de Bruin
| http://www.rondebruin.nl
Click to expand...
Click to expand...
Click to expand...
 
T

Tim

Thanks Ron. I sent you an email on your site.

Ron de Bruin said:
Hi Tim

Never test it with so many characters in a cell
Excel is not a Word editor<vbg>

Will look at it this weekend

--
Regards Ron de Bruin
http://www.rondebruin.nl


Tim said:
No I haven't. This what I am running. It works as long as cell N10 is less
than 120 characters.

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 Mail_Text_in_Body_3()
'Example for Outlook Express with API call
'In Excel 2002 I can use around 1800 characters
Dim msg As String, URL As String
Dim Recipient As String, Subj As String
Dim Recipientcc As String, Recipientbcc As String
Dim cell As Range
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""
'You can use a cell value also like this
'Recipient = Sheets("mysheet").Range("A1").Value
Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & "
for Incident " & Sheets("Employee List").Range("N7").Value
'Subj = Sheets("mysheet").Range("A2").Value
msg = "Statement for " & Sheets("Employee List").Range("Q1").Value
For Each cell In Sheets("Employee List").Range("N10")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")
'If you have hard returns in one of your cells you also need this line
(Tip from Keepitcool)
msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
URL = "mailto:" & Recipient & "?cc=" & Recipientcc & "&bcc=" &
Recipientbcc _
& "&subject=" & Subj & "&body=" & msg
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString,
vbNormalFocus
Application.Wait (Now + TimeValue("0:00:03"))
Application.SendKeys "%s"
End Sub



Ron de Bruin said:
We use Lotus Notes at work.

That's not good<g>

Have you try CDO

--
Regards Ron de Bruin
http://www.rondebruin.nl


We use Lotus Notes at work.

:

Hi Tim

http://www.rondebruin.nl/mail/oebody.htm
you can read about the limit on this page

Do you only use Outlook Express ?


--
Regards Ron de Bruin
http://www.rondebruin.nl


I think I tracked down the problem, too many characters. If I change "N8" to
a cell with less characters in it, it will work.
Any work around?

Thanks


Sub Mail_Text_in_Body()

Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Recipient = "(e-mail address removed)"
Recipientcc = ""
Recipientbcc = ""

Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & "
for Incident " & Sheets("Employee List").Range("P3").Value

msg = "Dear customer" & vbNewLine & vbNewLine
For Each cell In Sheets("Employee List").Range("N8")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")

msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc="
& Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg

ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:05"))
Application.SendKeys "%s"
End Sub



:

Nice. Thank you Ron

--
Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

:
| More Excel examples for CDO are here
| http://www.rondebruin.nl/cdo.htm
|
|
| --
| Regards Ron de Bruin
| http://www.rondebruin.nl
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Problem with Mail code 0
Why did this code stop working ? 0
Help with VBA 4
Send data from Excel in email from specific email address 5
Trouble with emailling in XP 1
Userform help needed 8
Outlook Express - how to send value of a cell... 3
Email value of a cell in Outlook Express 1

Top