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

Im having a problem trying to figure out why one email function works but
another one doesnt. 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 doesnt 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

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

"Tim" wrote:
| 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
|
|

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


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


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

"Tim" wrote:
| 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
|
|

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

"Ron de Bruin" wrote:
| More Excel examples for CDO are here
| http://www.rondebruin.nl/cdo.htm
|
|
| --
| 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 = "
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" wrote:

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

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

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

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

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