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
|
|