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!

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

Create and Send emails from Access using an SMTP server 4

Status
Not open for further replies.

MaltaC

Technical User
Jun 9, 2005
15
US
I need to Create and send multiple emails with attachements (Excel and PDF), to different recipients from Microsoft Access thru an SMTP server.

Is there anyway to code this in Access VBA?

Thanks



 
Do a google search for cdo smtp vba

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Here's a function that does it. You will need to set a reference to CDO.
Code:
Function Mail_SMTP(strNTUserName As String, _
                  strNTUserPwd As String, _
                  strFrom As String, _
                  strTo As String, _
         Optional strSubject As String, _
         Optional strBody As String, _
         Optional strBCC As String, _
         Optional strCC As String, _
         Optional strAttachment As String, _
         Optional strHTMLBody As String, _
         Optional strMailServer As String = "YourEmailServerName")

'********************************
'*  Declaration Specifications  *
'********************************

    Dim email As New CDO.Message
    
    On Error GoTo ErrHandler

    With email
        
        .From = strFrom
        .To = strTo
        
        If (Len(strAttachment) > 0) Then .AddAttachment strAttachment
        If (Len(strHTMLBody) > 0) Then .HTMLBody = strHTMLBody                '"<H4>See attached file</H4>"
        If (Len(strBCC) > 0) Then .BCC = strBCC
        If (Len(strCC) > 0) Then .CC = strCC
        If (Len(strSubject) > 0) Then .Subject = strSubject
        If (Len(strBody) > 0) Then .TextBody = strBody
        
        .Configuration.Fields.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2
        .Configuration.Fields.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = strMailServer    'Name or IP of Remote SMTP Server
        .Configuration.Fields.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/authenticate")[/URL] = 0              'Type of authentication, NONE, Basic (Base64 encoded), NTLM
        .Configuration.Fields.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusername")[/URL] = strNTUserName  'Your UserID on the SMTP server
        .Configuration.Fields.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendpassword")[/URL] = strNTUserPwd   'Your password on the SMTP server
        .Configuration.Fields.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = 25           'Server port (typically 25)
        .Configuration.Fields.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpusessl")[/URL] = False         'Use SSL for the connection (False or True)
        .Configuration.Fields.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout")[/URL] = 60 'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
        .Configuration.Fields.Update
    
        .Send
  
  End With

'********************
'*  Exit Procedure  *
'********************
        
ExitProcedure:

    Exit Function

'****************************
'*  Error Recovery Section  *
'****************************
        
ErrHandler:
        
    Err.Raise Err.Number, "Mail_SMTP", "An the following error occurred while attempting to send mail via Mail_SMTP." & vbCrLf & Err.Description
        
    Resume ExitProcedure

End Function
 
Is there a way to do it without using Exchange Server or Outlook?

 
MaltaC,
yes. do a search of this forum and you should find numerous posts.
hth
regards,
longhair
 
I'm assuming that this line..
Code:
Optional strMailServer As String = "YourEmailServerName")
is the address of the SMTP server you have access too.

I'm no expert but isn't SMTP = Simple Mail Transfer Protocol, meaning it has a defined way of receiving emails and sending regardless of platform the server runs under.

The method used to send via each platform is different sendmail for Unix, Net:SMTP for PERL to Windows, but the info being sent is the same.

When I connect to either manually I use the same commands.... HELO, To , From, Etc....

It should be the same for your purpose, connect to SMTP server, Authenticate, issue Commands passing email data, disconnect.

Hope that helps, for you to investigate further, I go the easy route and use Outlook for our internal systems via VBA, it is only for my web stuff I connect and send direct via Net:SMTP, or Sendmail for my Unix host.

Regards,

1DMF
 
I also found that the Windows API used for this is (ossmtp.dll)

along with this code...
Code:
Option Explicit

Public WithEvents oSMTP As OSSMTP.SMTPSession
--------------------------------------------------------------------------------
Private Sub cmdSend_Click()
  If Trim(txtServer) = "" Then
    MsgBox "Enter the server name or IP address"
    txtServer.SetFocus
    Exit Sub
  ElseIf Trim(txtMailFrom) = "" Then
    MsgBox "Enter the sender e-mail address"
    txtMailFrom.SetFocus
    Exit Sub
  ElseIf Trim(txtSendTo) = "" Then
    MsgBox "Enter the recipient e-mail address"
    txtSendTo.SetFocus
    Exit Sub
  ElseIf cmbAuth.ListIndex = 1 And Trim(txtPOPServer) = "" Then
    MsgBox "POP Authentication requires POP server"
    txtPOPServer.SetFocus
    Exit Sub
  End If
  If Trim(txtMessageSubject) = "" Then
    If MsgBox("You didn't enter the message subject. " & vbCrLf & _
    "Would you like to send it anyway?", vbYesNo) = vbNo Then Exit Sub
  End If
  If Trim(txtMessageText) = "" Then
    If MsgBox("You didn't enter the message text. " & vbCrLf & _
    "Would you like to send it anyway?", vbYesNo) = vbNo Then Exit Sub
  End If
  With oSMTP
    'authentication
    If cmbAuth.ListIndex > 0 Then
      .UserName = txtUsername
      .Password = txtPassword
    End If
    If cmbAuth.ListIndex = 1 Then .POPServer = txtPOPServer
    .AuthenticationType = cmbAuth.ListIndex
    
    .Server = txtServer
    .MailFrom = txtMailFrom
    .SendTo = txtSendTo
    .MessageSubject = txtMessageSubject
    .MessageText = txtMessageText
    .SendEmail
  End With
End Sub
--------------------------------------------------------------------------------
Private Sub txtStatus_Change()
  txtStatus.SelStart = Len(txtStatus)
End Sub
--------------------------------------------------------------------------------
Private Sub oSMTP_CloseSMTP()
'connection to mailserver closed
End Sub
--------------------------------------------------------------------------------
Private Sub oSMTP_ConnectSMTP()
'connected to mailserver
End Sub
--------------------------------------------------------------------------------
Private Sub oSMTP_ErrorSMTP(ByVal Number As Integer, _
      Description As String)
'error occured
End Sub
--------------------------------------------------------------------------------
Private Sub oSMTP_SendSMTP()
'message successfully sent
End Sub
--------------------------------------------------------------------------------
Private Sub oSMTP_StatusChanged(ByVal Status As String)
  txtStatus = txtStatus & oSMTP.Status & vbCrLf
End Sub
--------------------------------------------------------------------------------
Private Sub Form_Load()
  Set oSMTP = New OSSMTP.SMTPSession
  txtMailFrom.SetFocus
End Sub
--------------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
  Set oSMTP = Nothing
End Sub

let me know if it helps as i would be interested in knowing how to do this also, you never know when you might need this method :)
 
How do I "set a reference to CDO" ?

 
Ignore my last post regarding "set a reference to CDO".

Regarding FancyPrairie's solution which is working. How can I save the email so that it may be resent at a future time if need be?

Thanks



 
You could just create a table and store all of the pieces and parts of the email message in individual fields (i.e. From field, To field, Subject field, etc.). You might want to add a date/time field as to when the email message is to be sent and/or was sent.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top