Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Emailing using CDO

Emailing From Access

Emailing using CDO

by  hwkranger  Posted    (Edited  )
You can e-mail from ACCESS through an smtp server. All you need to know is your server name...

Code: 
'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

To use the function..

Code: 
Call SendOneEmailViaCDO("Hello, this is the body", "yourboss@yourcompany.com", "yourname@yourcompany.com", "Someone@yourcompany.com", "A witty subject", false)

Of course, it might be wiser to pass initialized variables rather than typing static messages to the function call, but -- either way works.
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top