Thread: Outlook Email
View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Nigel RS[_2_] Nigel RS[_2_] is offline
external usenet poster
 
Posts: 80
Default Outlook Email

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