MS ACCESS: send mail with CDO (send mail directly with smtp, without outlook or other program/client)

 from http://www.paulsadowski.com/wsh/cdo.htm

Windows 2000 and Windows XP use CDO messaging as a replacement for CDONTS.

Sending email with CDO is a simple task. First we create a reference to the CDO component




Set objMessage = CreateObject("CDO.Message")
then fill-in Sender, Subject and Recipient (To) fields of the headers and the body text which can be either plain text or HTML. You can also add a file attachment. You then use the Send method to send the email.

Below I'll show all three types of emails, and how to send an email using a remote SMTP server in the event you are not running your own. I've added and example to illustrate how to request a return receipt and delivery status notifications.

Please note, when using the AddAttachment method in your scripts you must use a fully qualified pathname as the argument to the method.  Using just a file name or a relative path will produce the error The specified protocol is unknown.

If you receive an error message related to objMessage.From then you should try replacing it with objMessage.Sender

I've added sample code to illustrate how to load the body of the email from a text file on your disk.

I've added a sample of how to load recipient data from a database.

I've added a sample illustrating how to use data from Excel in an email.

If you are looking for an ASP based email form processor then please look here.

If you are interested in a mass mailer using CDO and VBScript, look here.

  

This sample sends a simple text email that can be viewed in any email client.


Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Example CDO Message"
objMessage.From = "me@my.com"
objMessage.To = "test@paulsadowski.com"
objMessage.TextBody = "This is some sample message text."
objMessage.Send

Sending an HTML email.

Note the use of the Cc & Bcc properties to send using Blind Carbon Copy (Bcc) and Carbon Copy (Cc).
These properties can be used with either text or HTML email.

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Example CDO Message"
objMessage.From = "me@my.com"
objMessage.To = "test@paulsadowski.com" 'The line below shows how to send using HTML included directly in your script
objMessage.HTMLBody = "
This is some sample message html.

"

'The line below shows how to send a webpage from a remote site
'objMessage.CreateMHTMLBody "http://www.paulsadowski.com/wsh/"'The line below shows how to send a webpage from a file on your machine
'objMessage.CreateMHTMLBody "file://c|/temp/test.htm"

objMessage.Bcc = "you@your.com"
objMessage.Cc = "you2@your.com"
objMessage.Send

Sending a text email with an attached file. By repeating the .AddAttachment method you can attach more than one file.
When attaching files keep in mind that your recipient may be limited in their
ability to receive files above a certain size. Many ISPs limit emails to 8 or 10MB each.
You should not send large files to anyone before obtaining their permission.


Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Example CDO Message"
objMessage.From = "me@my.com"
objMessage.To = "test@paulsadowski.com"
objMessage.TextBody = "This is some sample message text."
objMessage.AddAttachment "c:\temp\readme.txt"
objMessage.Send

Sending a text email using a remote server. Sometimes you need to send email using another server. It may be required by your
company, or your ISP may be blocking the SMTP port, or your dynamic IP may be
blacklisted for being in a dynamic pool.

This code shows you how to use a remotes server rather than the SMTP server
on your own machine.


Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Example CDO Message"
objMessage.From = "me@my.com"
objMessage.To = "test@paulsadowski.com"
objMessage.TextBody = "This is some sample message text."

'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP. objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.myserver.com"

'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

objMessage.Configuration.Fields.Update

'==End remote SMTP server configuration section==

objMessage.Send

Sending a text email using authentication against a remote SMTP server. More and more administrators are restricting access to their servers to control spam or limit
which users may utilize the server. This example shows you how to use basic authentication,
the most commonly used authentication method, when the SMTP server you are using requires it.

This code is slightly more complex but not very difficult to understand or work with.


Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).

Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Example CDO Message"
objMessage.From = """Me"" "
objMessage.To = "test@paulsadowski.com"
objMessage.TextBody = "This is some sample message text.." & vbCRLF & "It was sent using SMTP authentication."

'==This section provides the configuration information for the remote SMTP server.

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.your.com"

'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic

'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "youruserid"

'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "yourpassword"

'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

objMessage.Configuration.Fields.Update

'==End remote SMTP server configuration section==

objMessage.Send

Send using authentication against a remote server with a file attachment and return receipt and
delivery disposition notification requests. In order to use the Delivery Status Notifications (Return
Receipt and Delivery Disposition requests) we need to create a reference to the CDO Configuration
object in addition to the CDO Message object and set a small number of properties. You must
use cdoSendUsingPort (network connection) and not the SMTP server's pickup directory
(cdoSendUsingPickup).


Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2 'Must use this to use Delivery Notification
Const cdoAnonymous = 0
Const cdoBasic = 1 ' clear text
Const cdoNTLM = 2 'NTLM
'Delivery Status Notifications
Const cdoDSNDefault = 0 'None
Const cdoDSNNever = 1 'None
Const cdoDSNFailure = 2 'Failure
Const cdoDSNSuccess = 4 'Success
Const cdoDSNDelay = 8 'Delay
Const cdoDSNSuccessFailOrDelay = 14 'Success, failure or delay

set objMsg = CreateObject("CDO.Message")
set objConf = CreateObject("CDO.Configuration")

Set objFlds = objConf.Fields
With objFlds
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.yourhost.com"
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "your-username"
  .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "your-password"
  .Update
End With

strBody = "This is a sample message." & vbCRLF
strBody = strBody & "It was sent using CDO." & vbCRLF

With objMsg
  Set .Configuration = objConf
  .To = "test@paulsadowski.com"
  .From = "me@my.com"
  .Subject = "This is a CDO test message"
  .TextBody = strBody
   'use .HTMLBody to send HTML email.
  .Addattachment "c:\temp\Scripty.zip"
  .Fields("urn:schemas:mailheader:disposition-notification-to") = "me@my.com"
  .Fields("urn:schemas:mailheader:return-receipt-to") = "me@my.com"
  .DSNOptions = cdoDSNSuccessFailOrDelay
  .Fields.update
  .Send
End With

In real world usage you'll most likely want to load the text of the email from a file on your
computer. The sample code below shows you how to do this. The text can be either
plain text or HTML as needed.Our example assumes your text is in the file
C:\Temp\MyEmail.txt. This code loads the entire content of that file into a variable,
here named BodyText which you can then reference in your CDO code. We
assume BodyText is in the scope of your CDO code.


'These constants are defined to make the code more readable
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
'Open the file for reading
Set f = fso.OpenTextFile("c:\temp\MyEmail.txt", ForReading)
'The ReadAll method reads the entire file into the variable BodyText
BodyText = f.ReadAll
'Close the file
f.Close
Set f = Nothing
Set fso = Nothing

Once the text is loaded you can use it in your CDO code something like this...

objMessage.TextBody = BodyText
or
objMessage.HTMLBody = BodyText

Load Recipients from a Database As is the case with most thing in Windows there are many ways to accomplish a task. This is one method of many.

Our database is an Access format database that resides on the local disk. The table in our database that we are     interested in is called Customers and each record consists of 4 fields named "ID", "Name", "Email", and "Customer", where ID is an autogenerated index, Name is the full name of our customer, Email is the customer's email address and Customer is their customer identification number.

We are only interested here in two fields, Name and Email.

ID
  

Name
  

Email
  

Customer

1
  

Bob Jones
  

bjones@test.com
  

12345

2
  

Jane Smith
  

jsmith@test.net
  

12346

Set OBJdbConnection = CreateObject("ADODB.Connection")
OBJdbConnection.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=c:\Acme Inc\Databases\Customers.mdb"
SQLQuery = "SELECT Name, Email FROM Customers"
Set Result = OBJdbConnection.Execute(SQLQuery)
if Not Result.EOF then
  Do While Not Result.EOF
    SendMail Result("Name"), Result("Email")
    Result.MoveNext
  Loop
end if
OBJdbConnection.Close

As you can see the code is simple. We create a database connection object then open the database and query it for the Name and Email fields of each customer. Those values are passed for each customer to a subroutine that sends the customer an email.

Sub SendMail(TheName, TheAddress)
Dim objMessage, Rcpt

Rcpt = Chr(34) & TheName & Chr(34) & "<" & TheAddress & ">"
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "This Month's Sales" objMessage.From = """Acme Sales"" "
objMessage.To = Rcpt
objMessage.HTMLBody = TextBody
objMessage.Send

End Sub


If you are not accustomed to working with databases then this may have seemed a daunting task but as you can see from the code above, it's really quite simple.

We've already covered sending email so I'll just mention that this subroutine assumes the HTML body text is a variable called TextBody (see Loading email body text from a file)

Also we format the recipient's address in the standard format of "Name" for a more professional look to the recipient..
Remarks

As previously stated there are many ways to do this. I've presented one simple method here. Your own use may be with an ODBC connection; it may use mySQL or SQL Server; it may include personalization of the email body text and more. My intent here was to provide you with the basics to get you started.

Load data from an Excel Worksheet


There may be times when you want to generate an email using data from an application such as Excel. This is one simple illustration of how that could be done. In our example we will be using a Workbook with three columns starting at column A row 1. Each row represents one product in our inventory and the three columns contains the following data about each item: Part Number, Name of Part, Number of Items in Inventory. Graphically our Workbook looks like this:

Part
  

Name
  

Stock

4583586
  

Fliggalhopper
  

452

5898547
  

Looplonger
  

293

This particular script works by walking down each cell of column 1 till it finds an empty cell which it assumes is the end of the list of entries. If your file may contain empty cells then you can use the Worksheet's UsedRange.Rows.Count property to find the last row in which an entry is made. Your code would then use a for loop something like this:


rowLast = objSheet.UsedRange.Rows.Count
for x = rowStart to rowLast
' do stuff
next

Function GetData()
Dim x, strTemp, objExcel, objWB

Set objExcel = Wscript.CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Open("c:\Acme Inc\Workbooks\Test.xls")
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' Make Excel visible while debugging
objExcel.Visible = True

' This is the row of our first cell.
x = 1

do while objExcel.Cells(x, 1).Value <> ""
  strTemp = strTemp & objExcel.Cells(x, 1).Value & _
    Space(10 - Len(objExcel.Cells(x, 1).Value))
  strTemp = strTemp & objExcel.Cells(x, 2).Value & _
    Space(50 - Len(objExcel.Cells(x, 2).Value))
  strTemp = strTemp & objExcel.Cells(x, 3).Value & vbCRLF
  x = x + 1
loop

' This will prevent Excel from prompting us to save the workbook.
objExcel.ActiveWorkbook.Saved = True

' Close the workbook and exit the application.
objWB.Close
objExcel.Quit

set objWB = Nothing
set objExcel = Nothing

GetData = strTemp
End Function

' This is our main function.
Dim strBody

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Inventory report for " & Date
objMessage.From = "me@my.com"
objMessage.To = "bossman@my.com"
strBody = "Part" & Space(6) & "Item" & Space(46) & "Stock" & vbCRLF

' Here we call the function GetData to populate the body text.
strBody = strBody & GetData

objMessage.TextBody = strBody
objMessage.Send
The code above will produce an email that looks something like this:

To: bossman@my.com
From: me@my.com
Subject: Inventory report for 3/19/2005

Part      Item                                              Stock
4583586   Fliggalhopper                                     452
5898547   Looplonger                                        293

This sample sends a simple text email via GMail servers.

It's like any other mail but requires that you set the SMTP Port to 465 and tell CDO to use SSL


Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).

Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Example CDO Message"
objMessage.From = """Me"" "
objMessage.To = "me@my.com"
objMessage.TextBody = "This is some sample message text.." & vbCRLF & "It was sent using SMTP authentication and SSL."

'==This section provides the configuration information for the remote SMTP server.

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic

'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "You@gmail.com"

'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "YourPassword"

'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465

'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

objMessage.Configuration.Fields.Update

'==End remote SMTP server configuration section==

objMessage.Send


ANOTHER CODE from http://www.tek-tips.com/faqs.cfm?fid=6504

'REQUIRES MICROSOFT CDO LIBRARY INCLUSION
Public Function SendOneEMailViaCDO(strBody As String, _
                                        strTo As String, _
                                        strFrom, _
                                        strBCC, _
                                        strSubject As String, _
                                        bolHighImportance As Boolean) As Boolean
 
    Const ROUTINE_NAME = "SendOneEMailViaCDO"
  
    Dim bolResults As Boolean
    Dim strServerName As String
  
    strServerName = "PUT YOUR SERVER NAME HERE"
  
    bolResults = True
  
 
    Dim objCDOMsg As CDO.Message
    Dim objCDOConfiguration As CDO.Configuration
 
  
  
    Set objCDOMsg = CreateObject("CDO.Message")
    Set objCDOConfiguration = CreateObject("CDO.Configuration")
  
    With objCDOConfiguration
      
        .Fields.Item("urn:schemas:mailheader:X-Mailer") = "Microsoft CDO for Windows 2000"

        .Fields(cdoSendUsingMethod) = 2    'cdoSendUsingPort
        .Fields(cdoSMTPServer) = strServerName
        .Fields(cdoSMTPAuthenticate) = 0 'cdoAnonymous
        .Fields(cdoSMTPServerPort) = 25
        .Fields(cdoSMTPConnectionTimeout) = 10
      
        'message headers
        '.Fields.Item("urn:schemas:mailheader:date") = "Tue, 6 Oct 2005 11:15:08 -0700"
        '.Fields("Date") = "Tue, 6 Oct 2005 11:15:08 -0700"
        '.Fields.Update
        '.Fields.Resync
      
      
        If bolHighImportance = True Then
          .Fields(cdoImportance) = cdoHigh 'cdoHigh   'High importance
          .Fields("urn:schemas:mailheader:X-MSMail-Priority") = "High" 'cdoHigh
          .Fields("urn:schemas:mailheader:X-Priority") = 2
        Else
          .Fields(cdoImportance) = cdoNormal  'High importance
          .Fields("urn:schemas:mailheader:X-MSMail-Priority") = cdoNormal
          .Fields("urn:schemas:mailheader:X-Priority") = 5
        End If
        .Fields.Update
    End With
  
    Set objCDOMsg.Configuration = objCDOConfiguration

   With objCDOMsg
         .MimeFormatted = False
         .AutoGenerateTextBody = False
         .To = strTo
                   
         .From = strFrom
         .Subject = strSubject
         .HTMLBody = strBody
          
         If bolHighImportance = True Then
             '.Fields(cdoImportance) = cdoHigh
         Else
             '.Fields(cdoImportance) = cdoNormal
         End If
         .Fields.Update
       
         .Send
   End With
 
    Set objCDOMsg = Nothing
    Set objCDOConfiguration = Nothing
 
ExitRoutine:

 
End Function

  

  

  

  

  

  

          

Nessun commento: