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.
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"" "
.Subject = "New figures"
.TextBody = strbody
.Send
End With
End Sub
Note: If you get this error : The transport failed to connect to the server
then try to change the SMTP port from 25 to 465
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 = "
Dear Ron de Bruin
" & _"Please visit this website to download an update.
" & _
"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
http://www.rondebruin.nl/cdo.htm
No comments:
Post a Comment