注册 登录
Office中国论坛/Access中国论坛 返回首页

rcylbx的个人空间 http://www.office-cn.net/?52107 [收藏] [复制] [分享] [RSS]

日志

Sending mail from Excel with CDO

已有 2878 次阅读2009-2-19 16:09 |个人分类:程序设计|

Sending mail from Excel with CDO
Ron de Bruin (last update 31-Oct-2007)
Go back to the mail tips page

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 mail program to send email.
<You can send mail without a mail program>

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 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…2007)
3: You can send a range/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 Security warnings anymore, really great if you are sending a lot of mail in a loop.


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 or Windows Mail.
In that case the system doesn't know the name of your SMTP server.
If this happens you can use the commented green 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 = ""

Note: It is always possible that your firewall block the code (Check your firewall settings)


Can you use CDO on your machine?

Let's try a basic example first.

The code below will send four text lines in the body of the mail to the person in this line
.To = "ron@debruin.nl"

Change ron@debruin.nl to your own mail address before you test the code.
If you read the information above you know that if you have a account in Outlook Express or
Windows Mail you can Run the code below after changing the mail address.
But if you not have a account in Outlook Express or Windows Mail you also need the commented
green lines in the code. Remove every ' before every green line and fill in the name of your SMTP server
where it says "Fill in your SMTP server here"

1) Open a new workbook
2) Alt F11 (to open the VBA editor)
3) Insert>Module
4) Paste the code in this module
5) Make your changes
6) Alt q to go back to Excel

When you use Alt F8 you can select the macro and press Run.
Now wait a moment and see if you receive the mail in your inbox.
Sub CDO_Mail_Small_Text() 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 = "ron@debruin.nl" .CC = "" .BCC = "" .From = """Ron"" <ron@something.nl>" .Subject = "Important message" .TextBody = strbody .Send End With End Sub
Use the GMail SMTP server from Google.
http://gmail.google.com

You can find the code in the workbook with examples that you can download below.
There is more information about the code in the workbook.
Note: You must have a Gmail account to try this example.




Download workbook with more examples

You can download a example workbook with eighth examples.
Download Example workbook with all the code

Attachment examples:
Module file1 = Workbook
Module file2 = One worksheet or more
Module file3 = Every sheet with a mail address in cell A1

Body examples:
Module body1 = Selection/Range or whole worksheet
Module body2 = Personalized Mail
Module body3 = Every sheet with a mail address in cell A1
Module body4 = Small text and text from a txt file

Note: the body examples in the workbook are using the function RangetoHTML in
the "bodyfunction" module of the workbook.

Gmail example:
Module gmail = Use the smtp.gmail.com server from Gmail to send mail



Tips and links


CDO sheet template

Check out this sheet template if you want to send every sheet to a different person.
Or want to send one or more sheets to one or more recipient.
http://www.rondebruin.nl/mail/templates.htm



Set importance/priority and request read receipt

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

' Set importance or Priority to high
.Fields("urn:schemas:httpmail:importance") = 2
.Fields("urn:schemas:mailheader:X-Priority") = 1

' Request read receipt
.Fields("urn:schemas:mailheader:return-receipt-to") = "ron@debruin.nl"
.Fields("urn:schemas:mailheader:disposition-notification-to") = "ron@debruin.nl"

' Update fields
.Fields.Update


Changing the To line

If you want to mail to all E-mail addresses in a range then use this code
instead of .To = "ron@debruin.nl"

The example below will use the cells from sheets("Sheet1") in ThisWorkbook (workbook with the code)
It is possible that you must use ActiveWorkbook or something else in your code to use it. Dim cell As Range Dim strto As String On Error Resume Next For Each cell In ThisWorkbook.Sheets("Sheet1") _ .Range("A1:A10").Cells.SpecialCells(xlCellTypeConstants) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next cell On Error GoTo 0 If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
Change the To line to .To = strto


Or to more people
.To = "Jon@something.com;ron@something.com"

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



Change the Body line


Plain text :


Note: see also the example in the workbook to send all text from a txt file (Module body4)

If you want to add more text to the body then you can use the code below.
Instead of .TextBody = "This is the body text" use .TextBody = strbody then.

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




Links

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



HTML text :

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>Dear Ron de Bruin</H3>" & _
"Please visit this website to download an update.
" & _
"<A HREF=""http://www.rondebruin.nl/"">Ron's Excel Page"



Tip: Or send a complete webpage, instead of HTMLBody or TextBody use

.CreateMHTMLBody "http://www.rondebruin.nl/copy1.htm"

Or file on your computer
.CreateMHTMLBody "file://C:/test.htm"



Copy the cells as values

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

See this page for example code that you can use
http://www.rondebruin.nl/values.htm



Test if you are online

You can use code like this in your subroutine to avoid errors if you run the code
when you are not online (example below is for a dial up connection)

For checking other connections check out this great 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

发表评论 评论 (3 个评论)

回复 t小宝 2009-2-20 11:11
一个字都看不懂
回复 rcylbx 2009-2-20 16:20
我也不懂,放在这,看有谁看得懂。
回复 rcylbx 2009-2-22 09:05
t小宝: 一个字都看不懂
我看懂一点了,讲的是在EXCEL中,如何引用CEO发送邮件,里面有示例代码,邮箱用的是gmail

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-3 02:21 , Processed in 0.064087 second(s), 18 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部