E-mail pelo Excel - II

Continuo achando que é mais fácil fazer o código no próprio Outlook, mas muitos usuários ainda querem enviar e-mails através de outros aplicativos.
Possível é, mas são tantos os problemas de automação que não vejo o porque de tanta insistência em fazer o código no Excel e/ou outros aplicativos, haja vista que, quem usa o Office, quase sempre está com o Outlook aberto.
É a velha história do InputBox com máscara de senha: basta criar a tela com caixa de texto e alterar a máscara para "*****". Para que inventar códigos mirabolantes para fazer o InputBox receber senha? Ele não foi projetado para isso!
Bem, num dos grupos de Excel que participo recebi esta interessante mensagem sobre como mandar e-mails pelo Excel.
O problema que gerou a discussão, é a mensagem de confirmação que o Outlook exibe quando outro aplicativo tenta enviar e-mails através ele: "confirma (s/n)?".
Não testei o código e nem vou testar, apenas vou deixar registrado aqui para quem quiser se aventurar.
Ah, lembrando também que existe um programa chamado "ClickYes" para quem ainda tem o problema da mensagem de confirmação do Outlook.

abs!

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


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.


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

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