Hi All
I am using Outlook to send emails from within Excel 2003. The security
message asking using to confirm they wish to send appears as expected. If
the uses presses 'Yes' everytnig works OK. How do I detect if the user
presses either the 'No' or 'Cancel' control as this causes an error.

Cheers
Nigel RS

Snippet of code follows.....
-----------------------------------------------------------
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
.To = xmailAdd
.Subject = "CFAM File: " & xFName
.Attachments.Add xmailAttach, olByValue, 1, "Data File"
.DeleteAfterSubmit = False
On Error Resume Next
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing
--------------------------------------------------------

Hi Nigel,

See Ron de Bruin's suggestions at:

http://www.rondebruin.nl/mail/prevent.htm

See also:

http://www.rondebruin.nl/cdo.htm

---
Regards,
Norman


"Nigel RS" wrote in message
...
Hi All
I am using Outlook to send emails from within Excel 2003. The security
message asking using to confirm they wish to send appears as expected. If
the uses presses 'Yes' everytnig works OK. How do I detect if the user
presses either the 'No' or 'Cancel' control as this causes an error.

Cheers
Nigel RS

Snippet of code follows.....
-----------------------------------------------------------
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
.To = xmailAdd
.Subject = "CFAM File: " & xFName
.Attachments.Add xmailAttach, olByValue, 1, "Data File"
.DeleteAfterSubmit = False
On Error Resume Next
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing
--------------------------------------------------------

hi Norman
Thanks for the link, unfortunately I cannot read this page from my office as
my IS group restrict access - I will try from home later. Unless you might
post a code snippet to help me on my way?.

Cheers
Nigel RS

"Norman Jones" wrote:

Hi Nigel,

See Ron de Bruin's suggestions at:

http://www.rondebruin.nl/mail/prevent.htm

See also:

http://www.rondebruin.nl/cdo.htm

---
Regards,
Norman


"Nigel RS" wrote in message
...
Hi All
I am using Outlook to send emails from within Excel 2003. The security
message asking using to confirm they wish to send appears as expected. If
the uses presses 'Yes' everytnig works OK. How do I detect if the user
presses either the 'No' or 'Cancel' control as this causes an error.

Cheers
Nigel RS

Snippet of code follows.....
-----------------------------------------------------------
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
.To = xmailAdd
.Subject = "CFAM File: " & xFName
.Attachments.Add xmailAttach, olByValue, 1, "Data File"
.DeleteAfterSubmit = False
On Error Resume Next
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing
--------------------------------------------------------

Hi Nigel,

Thanks for the link, unfortunately I cannot read this page from my
office as my IS group restrict access - I will try from home later

The site is well worth you taking the time out this evening to visit it!

Unless you might post a code snippet to help me on my way?.


(1) http://www.rondebruin.nl/mail/prevent.htm
How To Prevent displaying the dialog that enables you Index
to send or not send the message

Outlook Redemption

http://www.dimastr.com/redemption/

Instead of .Send in the code examples you can use this three lines instead
of .Send

( SendKeys is not always reliable and this will not work on every computer)

Note: the S is from Send, if you not use a English version you must change
this letter.

You can only use this if you use the Outlook object model examples from my
site.

.Display

Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%S"


CDO

There are no security warnings when you use CDO to send mail (my favorite
way to send mail)
http://www.rondebruin.nl/cdo.htm


(2) http://www.rondebruin.nl/cdo.htm

Sending mail from Excel with CDO
Ron de Bruin (last update 25 June 2006)
Go to the Excel tips page

Read this!!!

This code will not work in Win 98 and ME.
You must be connected to the internet when you run a example.

It is possible that you get a Send error when you use one of the examples.
AFAIK : This will happen if you haven't setup an account in Outlook Express.
In that case the system doesn't know the name of your SMTP server.
If this happens you can use the commented blue lines in each example.
Don't forget to fill in the SMTP server name in each code sample where
it says "Fill in your SMTP server here"

When you also get the Authentication Required Error you can add this three
lines.
..Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
..Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
"username"
..Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
"password"

Don't remove the TextBody line in the code. If you do you can't open the
attachment (bug in CDO).
If you don't want to have text in the body use this then .TextBody = ""

Sending a small message
Sending the ActiveWorkbook (attachment)
Sending a sheet or sheets as a attachment
Sending a sheet in the body of the mail
Sending the Selection in the body of the mail
Sending every sheet with address in A1 in the body of the mail
Sending every sheet with address in A1 as a attachment
Mail a message to each person in a range
Download a Sheet template on my SendMail page
Tips and links

What is CDO doing

The example code is using CDOSYS (CDO for Windows 2000).
It does not depend on MAPI or CDO and hence is dialog free
and does not use your mailbox to send email.
<You can send mail without a mail program or mail account

Briefly to explain, this code builds the message and drops it
in the pickup directory, and SMTP service running on the machine
picks it up and send it out to the internet.


Why using CDO code instead of Outlook automation or Application.SendMail in
VBA.

1: It doesn't matter what Mail program you are using (It only use the SMTP
server).
2: It doesn't matter what Office version you are using (97.2003)
3: You can send a sheet in the body of the mail (some mail programs can't do
this)
4: You can send any file you like (Word, PDF, PowerPoint, TXT files,..)
5: No Outlook Security warning anymore, really great if you are sending a
lot of mail in a loop.

Sending a small message

Sub Mail_Small_Text_CDO()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
' Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = "Important message"
.TextBody = strbody
.Send
End With

Set iMsg = Nothing
Set iConf = Nothing
End Sub

Tip: If you want to send the text from a txt file in the body then use this
line
..TextBody = GetBoiler("c:\test.txt") and copy this function in a normal
module

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

Sending the ActiveWorkbook (attachment)

You can't send the ActiveWorkbook with CDO.
That's why it use SaveCopyAs to save it with another name and send that
file.

Sub CDO_Send_Workbook()
Dim iMsg As Object
Dim iConf As Object
Dim wb As Workbook
Dim WBname As String
' Dim Flds As Variant

Application.ScreenUpdating = False
Set wb = ActiveWorkbook

' It will save a copy of the file in C:/ with a Date and Time stamp
WBname = wb.Name & " " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls"
wb.SaveCopyAs "C:/" & WBname

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = "This is a test"
.TextBody = "This is the body text"
.AddAttachment "C:/" & WBname
.Send
End With

'If you not want to delete the file you send delete this line
Kill "C:/" & WBname

Set iMsg = Nothing
Set iConf = Nothing
Set wb = Nothing
Application.ScreenUpdating = True
End Sub

Sending a sheet or sheets in a new workbook as attachment

Sub CDO_Send_ActiveSheet()
Dim iMsg As Object
Dim iConf As Object
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBname As String
' Dim Flds As Variant

Application.ScreenUpdating = False
Set WB1 = ActiveWorkbook

ActiveSheet.Copy
'Other possibility's are
'Sheets("Sheet3").Copy
'Sheets(Array("Sheet1", "Sheet3")).Copy

Set WB2 = ActiveWorkbook

' It will save the new file with the ActiveSheet in C:/ with a Date and
Time stamp
WBname = "Part of " & WB1.Name & " " & Format(Now, "dd-mm-yy h-mm-ss") &
".xls"
WB2.SaveAs "C:/" & WBname
WB2.Close False

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = "This is a test"
.TextBody = "Hi there"
.AddAttachment "C:/" & WBname
.Send
End With

'If you not want to delete the file you send delete this line
Kill "C:/" & WBname

Set iMsg = Nothing
Set iConf = Nothing
Set WB1 = Nothing
Set WB2 = Nothing
Application.ScreenUpdating = True
End Sub


Sending a sheet in the body of the mail

Don't forget to copy the function also (It is not working without it).

Sub CDO_Send_ActiveSheet_Body()
Dim iMsg As Object
Dim iConf As Object
' Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = "This is a test"
.HTMLBody = SheetToHTML(ActiveSheet)
.Send
End With

Set iMsg = Nothing
Set iConf = Nothing
End Sub

Public Function SheetToHTML(sh As Worksheet)
'Function from Dick Kusleika his site
'http://www.dicks-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 25-June-2006
Dim TempFile As String
Dim Nwb As Workbook
Dim fso As Object
Dim ts As Object

sh.Copy
Set Nwb = ActiveWorkbook

With Nwb.Sheets(1)
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Nwb.SaveAs TempFile, xlHtml
Nwb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close

Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
Kill TempFile
End Function

Sending the selection in the body of the mail

Don't forget to copy the function also (It is not working without it).

Sub CDO_Send_Selection_Body()
Dim iMsg As Object
Dim iConf As Object
Dim sh As Worksheet
Dim rng As Range
' Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

'To send the selection use this example (is only working if the sheet is
unprotected)
Set sh = ActiveSheet
Set rng = Selection

'If you know the sheet/range then use this two lines
' Set sh = Sheets("Sheet1") '<<< Change
' Set rng = sh.Range("A1:D10") '<<< Change

Application.ScreenUpdating = False
With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = "This is a test"
.HTMLBody = RangetoHTML(sh, rng)
.Send
End With

Application.ScreenUpdating = True
Set iMsg = Nothing
Set iConf = Nothing
End Sub

Public Function RangetoHTML(sh As Worksheet, rng As Range)
'Changed by Ron de Bruin 25-June-2006
' You can't use this function in Excel 97
Dim TempFile As String
Dim Nwb As Workbook
Dim fso As Object
Dim ts As Object

sh.Copy
Set Nwb = ActiveWorkbook

With Nwb.Sheets(1)
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

With Nwb.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=sh.Name, _
source:=rng.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

Nwb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close

Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
Kill TempFile
End Function

Sending every sheet with address in A1 in the body of the mail

This procedure will mail every Worksheet with an address in cell A1in the
body of the mail.
This way you can send each sheet to another person.
It does this by cycling through each worksheet in the workbook and checking
cell A1 for the @ character.
If found, a copy of the worksheet is made, and then sent by e-mail to the
address in cell A1.
And finally, the file is deleted from your hard disk

You need the SheetToHTML Function to use this sub.

Sub CDO_Mail_Every_Worksheet_Body()
Dim iMsg As Object
Dim iConf As Object
Dim ws As Worksheet
' Dim Flds As Variant

Application.ScreenUpdating = False

' Set iConf = CreateObject("CDO.Configuration")
' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

For Each ws In ThisWorkbook.Worksheets
If ws.Range("a1").Value Like "?*@?*.?*" Then
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = ws.Range("a1").Value
.From = """Ron"" "
.Subject = "Body of sheet : " & ws.Name
.HTMLBody = SheetToHTML(ws)
.Send
End With
Set iMsg = Nothing
End If
Next ws

Set iConf = Nothing
Application.ScreenUpdating = True
End Sub

Sending every sheet with address in A1 as a attachment

This procedure will mail every Worksheet with an address in cell A1.
This way you can send each sheet to another person.
It does this by cycling through each worksheet in the workbook and checking
cell A1 for the @ character.
If found, a copy of the worksheet is made, and then sent by e-mail to the
address in cell A1.
And finally, the file is deleted from your hard disk

Sub CDO_Mail_Every_Worksheet_File()
Dim iMsg As Object
Dim iConf As Object
Dim ws As Worksheet
Dim wb As Workbook
Dim WBname As String
' Dim Flds As Variant

Application.ScreenUpdating = False

' Set iConf = CreateObject("CDO.Configuration")
' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

For Each ws In ThisWorkbook.Worksheets
If ws.Range("a1").Value Like "?*@?*.?*" Then
ws.Copy
Set wb = ActiveWorkbook
WBname = "c:/Sheet " & ws.Name & ".xls"
wb.SaveAs WBname
wb.Close False
Set wb = Nothing

Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = ws.Range("a1").Value
.From = """Ron"" "
.Subject = "Sheet: " & ws.Name
.AddAttachment WBname
.TextBody = "Hi there"
.Send
End With
Set iMsg = Nothing
Kill WBname
End If
Next ws

Set iConf = Nothing
Application.ScreenUpdating = True
End Sub

Mail a message to each person in a range

Make a list in Sheet("Sheet1") with
In column A the names of the people
In column B the E-mail addresses
In column C yes or no , if the value is yes a mail will be send

The Macro will loop through each row in Sheet1 and if there is a E-mail
address in column B
and "yes" in column C it will create a mail with a reminder like this for
each person.

Dear Jelle (Jelle is a name in column A for example)

Please contact us to discuss bringing your account up to date

Sub Message()
Dim iMsg As Object
Dim iConf As Object
Dim cell As Range
' Dim Flds As Variant

Application.ScreenUpdating = False

' Set iConf = CreateObject("CDO.Configuration")
' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

For Each cell In
Sheets("Sheet1").Columns("B").Cells.SpecialCells(x lCellTypeConstants)
If cell.Offset(0, 1).Value < "" Then
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value)
= "yes" Then
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = cell.Value
.From = """Ron"" "
.Subject = "Reminder"
.TextBody = "Dear " & cell.Offset(0, -1).Value &
vbNewLine & vbNewLine & _
"Please contact us to discuss bringing your
account up to date"
.Send
End With
Set iMsg = Nothing
End If
End If
Next cell

Set iConf = Nothing
Application.ScreenUpdating = True
End Sub

Tips and links

Set importance/priority and request read receipt

For importance/priority you can add this in the With iMsg part of the macro
before .Send

' Set importance high, will work if the receiver have Outlook
.Fields("urn:schemas:httpmail:importance") = 2

' Set Priority high, will work if the receiver have Outlook Express
.Fields("urn:schemas:mailheader:X-Priority") = 1

' Update fields
.Fields.Update

If you want to add a request read receipt then you can use this.
Note: this is only working if the receiver have Outlook Express.

' Request read receipt if the receiver have Outlook Express
.Fields("urn:schemas:mailheader:return-receipt-to") =
"

' Update fields
.Fields.Update

Changing the To line

The examples below will use the cells from sheets("Sheet1") in the
ActiveWorkbook
It is possible that you must use ThisWorkbook or something else in your code
to use it.

If you want to mail to all E-mail addresses in column C use this code
instead of .To = "

Dim cell As Range
Dim strto As String
For Each cell In
Sheets("Sheet1").Columns("C").Cells.SpecialCells(x lCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

Change the To line to .To = strto

Or to more people
..To = "

Or you can use a address in a cell like this
.To = Sheets("Sheet1").Range("C1").Value

Change the Body line

If you want to add more text to the body then
instead of .TextBody = "This is the body text" use this.

Dim strbody As String
strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

Or use this if you want to use cell values

Dim cell As Range
Dim strbody As String
For Each cell In Sheets("Sheet1").Range("C1:C20")
strbody = strbody & cell.Value & vbNewLine
Next

Or this one

Dim strbody As String
With Sheets("Sheet1")
strbody = "Hi there" & vbNewLine & vbNewLine & _
.Range("A1") & vbNewLine & _
.Range("A2") & vbNewLine & _
.Range("A3") & vbNewLine & _
.Range("A4")
End With

Change the Body line to .TextBody = strbody to use the string.

You can also send links in the body

..TextBody = "file://Yourcomputer/YourFolder/Week2.xls"

'If there are spaces use %20
..TextBody = "file://Yourcomputer/YourFolder/Week%202.xls"

'Example for a file on a website
..TextBody = "http://www.rondebruin.nl/files/EasyFilter.zip"


If you want to create emails that are formatted you can use HTMLBody (Office
2000 and up) instead of TextBody .
You can find a lot of WebPages on the internet with more HTML tags examples.

.HTMLBody = "<H3<BDear Ron de Bruin</B</H3" & _
"Please visit this website to download an update.<BR" &
_
"<A HREF=""http://www.rondebruin.nl/""Ron's Excel
Page</A"

Copy the cells as values

If you want to paste as values the sheet must be unprotect!!!!!
Or Unprotect and Protect the sheet in the Sub also.

Below one of this lines in the example subs (if you copy one Sheet)
ws.copy
Activesheet.copy

Add this :
Cells.Copy
Cells.PasteSpecial xlPasteValues
Cells(1).Select
Application.CutCopyMode = False

If you copy more sheets in the newly created workbook
(Sheets(Array("Sheet1", "Sheet3")).Copy)
Then use this after the copy line.

Worksheets.Select
Cells.Copy
Cells.PasteSpecial xlPasteValues
Cells(1).Select
Worksheets(1).Select
Application.CutCopyMode = False

Test if you are online

You can use code like this in your subroutine to avoid errors
if you are not online (only with dial up connections)

For checking other connections check out this website
http://vbnet.mvps.org/

Public Declare Function InternetGetConnectedState _
Lib "wininet.dll" (lpdwFlags As Long, _
ByVal dwReserved As Long) As Boolean

Function IsConnected() As Boolean
Dim Stat As Long
IsConnected = (InternetGetConnectedState(Stat, 0&) < 0)
End Function

Sub Test()
' Randy Birch
If IsConnected = True Then
MsgBox "Copy your mail code here"
Else
MsgBox "You can't use this subroutine because you are not online"
End If
End Sub

Links to more information about CDO for windows 2000

MSDN

Search for "CDO for Windows 2000" on MSDN

Paul R. Sadowski

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

www.aspfaq.com

http://www.aspfaq.com/show.asp?id=2026


---
Regards,
Norman

Thanks Norman for posting the site content. Really useful. I do not think
CDO can be used in my environment, but I will try the display and delayed
send using sendkeys.

Cheers
Nigel RS

"Norman Jones" wrote:

Hi Nigel,

Thanks for the link, unfortunately I cannot read this page from my
office as my IS group restrict access - I will try from home later

The site is well worth you taking the time out this evening to visit it!

Unless you might post a code snippet to help me on my way?.


(1) http://www.rondebruin.nl/mail/prevent.htm
How To Prevent displaying the dialog that enables you Index
to send or not send the message

Outlook Redemption

http://www.dimastr.com/redemption/

Instead of .Send in the code examples you can use this three lines instead
of .Send

( SendKeys is not always reliable and this will not work on every computer)

Note: the S is from Send, if you not use a English version you must change
this letter.

You can only use this if you use the Outlook object model examples from my
site.

.Display

Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%S"


CDO

There are no security warnings when you use CDO to send mail (my favorite
way to send mail)
http://www.rondebruin.nl/cdo.htm


(2) http://www.rondebruin.nl/cdo.htm

Sending mail from Excel with CDO
Ron de Bruin (last update 25 June 2006)
Go to the Excel tips page

Read this!!!

This code will not work in Win 98 and ME.
You must be connected to the internet when you run a example.

It is possible that you get a Send error when you use one of the examples.
AFAIK : This will happen if you haven't setup an account in Outlook Express.
In that case the system doesn't know the name of your SMTP server.
If this happens you can use the commented blue lines in each example.
Don't forget to fill in the SMTP server name in each code sample where
it says "Fill in your SMTP server here"

When you also get the Authentication Required Error you can add this three
lines.
..Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
..Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
"username"
..Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
"password"

Don't remove the TextBody line in the code. If you do you can't open the
attachment (bug in CDO).
If you don't want to have text in the body use this then .TextBody = ""

Sending a small message
Sending the ActiveWorkbook (attachment)
Sending a sheet or sheets as a attachment
Sending a sheet in the body of the mail
Sending the Selection in the body of the mail
Sending every sheet with address in A1 in the body of the mail
Sending every sheet with address in A1 as a attachment
Mail a message to each person in a range
Download a Sheet template on my SendMail page
Tips and links

What is CDO doing

The example code is using CDOSYS (CDO for Windows 2000).
It does not depend on MAPI or CDO and hence is dialog free
and does not use your mailbox to send email.
<You can send mail without a mail program or mail account

Briefly to explain, this code builds the message and drops it
in the pickup directory, and SMTP service running on the machine
picks it up and send it out to the internet.


Why using CDO code instead of Outlook automation or Application.SendMail in
VBA.

1: It doesn't matter what Mail program you are using (It only use the SMTP
server).
2: It doesn't matter what Office version you are using (97.2003)
3: You can send a sheet in the body of the mail (some mail programs can't do
this)
4: You can send any file you like (Word, PDF, PowerPoint, TXT files,..)
5: No Outlook Security warning anymore, really great if you are sending a
lot of mail in a loop.

Sending a small message

Sub Mail_Small_Text_CDO()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
' Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = "Important message"
.TextBody = strbody
.Send
End With

Set iMsg = Nothing
Set iConf = Nothing
End Sub

Tip: If you want to send the text from a txt file in the body then use this
line
..TextBody = GetBoiler("c:\test.txt") and copy this function in a normal
module

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

Sending the ActiveWorkbook (attachment)

You can't send the ActiveWorkbook with CDO.
That's why it use SaveCopyAs to save it with another name and send that
file.

Sub CDO_Send_Workbook()
Dim iMsg As Object
Dim iConf As Object
Dim wb As Workbook
Dim WBname As String
' Dim Flds As Variant

Application.ScreenUpdating = False
Set wb = ActiveWorkbook

' It will save a copy of the file in C:/ with a Date and Time stamp
WBname = wb.Name & " " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls"
wb.SaveCopyAs "C:/" & WBname

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = "This is a test"
.TextBody = "This is the body text"
.AddAttachment "C:/" & WBname
.Send
End With

'If you not want to delete the file you send delete this line
Kill "C:/" & WBname

Set iMsg = Nothing
Set iConf = Nothing
Set wb = Nothing
Application.ScreenUpdating = True
End Sub

Sending a sheet or sheets in a new workbook as attachment

Sub CDO_Send_ActiveSheet()
Dim iMsg As Object
Dim iConf As Object
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBname As String
' Dim Flds As Variant

Application.ScreenUpdating = False
Set WB1 = ActiveWorkbook

ActiveSheet.Copy
'Other possibility's are
'Sheets("Sheet3").Copy
'Sheets(Array("Sheet1", "Sheet3")).Copy

Set WB2 = ActiveWorkbook

' It will save the new file with the ActiveSheet in C:/ with a Date and
Time stamp
WBname = "Part of " & WB1.Name & " " & Format(Now, "dd-mm-yy h-mm-ss") &
".xls"
WB2.SaveAs "C:/" & WBname
WB2.Close False

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill
in your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = "This is a test"
.TextBody = "Hi there"
.AddAttachment "C:/" & WBname
.Send
End With

'If you not want to delete the file you send delete this line
Kill "C:/" & WBname

Set iMsg = Nothing
Set iConf = Nothing
Set WB1 = Nothing
Set WB2 = Nothing
Application.ScreenUpdating = True
End Sub


Sending a sheet in the body of the mail

Don't forget to copy the function also (It is not working without it).

Sub CDO_Send_ActiveSheet_Body()
Dim iMsg As Object
Dim iConf As Object
' Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")