Back to jkp-ads.com |
Ron de Bruin
|
Ron de Bruin decided to remove all Windows Excel content from his website for personal reasons. If you want to know why, head over to rondebruin.nl.
Luckily, Ron was kind enough to allow me to publish all of his Excel content here.
Most of these pages are slightly outdated and may contain links that don 't work. Please inform me if you find such an error and I'll try to fix it.
Kind regards
Jan Karel Pieterse
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.
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…2016)
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, really great if you are
sending a lot of mail in a loop.
This code will not work in Windows 98 and ME and will also not working on
your Mac.
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 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 possible that your firewall block the code (Check your firewall
settings)
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 lines in the code. Remove every '
before every commented 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
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
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
You can find a gmail code example in the workbook with examples that you can download
below. There is more information about the code in the workbook.
Note : Possible that you must also enable the "Less
Secure" option for GMail
https://www.google.com/settings/security/lesssecureapps
You can
download a example workbook with eighth examples (7-May-2017).
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 = will use the smtp.gmail.com server from
Gmail to send mail
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
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 =
"/rdb/files/EasyFilter.zip"
HTML text :
If you want to create emails that are
formatted you can use HTMLBody instead of TextBody. You can find a lot of
WebPages on the internet with more HTML tags examples.
.HTMLBody = "<H3><B>Dear Ron de Bruin</B></H3>" & _
"Please visit this website to download an update.<BR>" & _
"<A HREF=""/rdb/"">Ron's Excel Page</A>"
Tip: Or send a complete webpage, instead of HTMLBody or
TextBody use
.CreateMHTMLBody
"/rdb/copy1.htm"
Or file on your computer
.CreateMHTMLBody "file://C:/test.htm"
MSDN
Search for "CDO for Windows 2000" on MSDN
Paul R.
Sadowski
http://www.paulsadowski.com/wsh/cdo.htm