Calling Class Module Sub

Option Compare Database
Option Explicit
' *****************************************************************************
' Required declaration of the vbSendMail component (withevents is optional)
' You also need a reference to the vbSendMail component in the Project References
' *****************************************************************************
Private WithEvents poSendMail As vbSendMail.clsSendMail  'need to be a class module for WithEvents to work

Private Sub poSendMail_SendFailed(Explanation As String)
  ' vbSendMail 'SendFailed Event
  MsgBox ("Your attempt to send mail failed for the following reason(s): " & vbCrLf & Explanation)
End Sub

Public Sub SMTP_EMail_Sender(strRecipient As String, strSubject As String, strMessage As String, Optional strForm As String, Optional strCC As String)
'This routine sends e-mail using vbSendMail.dll
  Dim strServer As String
  Dim strFromDisplayName As String
  Dim strFrom As String
  
  Set poSendMail = New clsSendMail
  strServer = "mail.medtronic.com"
  strFrom = "robert.schmitt@medtronic.com"
  strFromDisplayName = "DTL Database"
  
  With poSendMail
    ' **************************************************************************
    ' Optional properties for sending email, but these should be set first
    ' if you are going to use them
    ' **************************************************************************
    .SMTPHostValidation = VALIDATE_NONE         ' Optional, default = VALIDATE_HOST_DNS
    .EmailAddressValidation = VALIDATE_SYNTAX   ' Optional, default = VALIDATE_SYNTAX
    .Delimiter = ";"                            ' Optional, default = ";" (semicolon)

    ' **************************************************************************
    ' Basic properties for sending email
    ' **************************************************************************
    .SMTPHost = strServer                  ' Required the fist time, optional thereafter
    .from = strFrom                       ' Required the fist time, optional thereafter
    .FromDisplayName = strFromDisplayName         ' Optional, saved after first use
    .Recipient = strRecipient                     ' Required, separate multiple entries with delimiter character
    .RecipientDisplayName = strRecipient      ' Optional, separate multiple entries with delimiter character
    .CcRecipient = strCC                        ' Optional, separate multiple entries with delimiter character
'    .CcDisplayName = txtCcName                  ' Optional, separate multiple entries with delimiter character
'    .BccRecipient = txtBcc                      ' Optional, separate multiple entries with delimiter character
    .ReplyToAddress = strFrom              ' Optional, used when different than 'From' address
    .Subject = strSubject                  ' Optional
    .Message = strMessage                     ' Optional
'    .Attachment = Trim(txtAttach.Text)          ' Optional, separate multiple entries with delimiter character

    ' **************************************************************************
    ' Additional Optional properties, use as required by your application / environment
    ' **************************************************************************
'    .AsHTML = bHtml                             ' Optional, default = FALSE, send mail as html or plain text
'    .ContentBase = ""                           ' Optional, default = Null String, reference base for embedded links
'    .EncodeType = MyEncodeType                  ' Optional, default = MIME_ENCODE
'    .Priority = etPriority                      ' Optional, default = PRIORITY_NORMAL
'    .Receipt = bReceipt                         ' Optional, default = FALSE
'    .UseAuthentication = bAuthLogin             ' Optional, default = FALSE
'    .UsePopAuthentication = bPopLogin           ' Optional, default = FALSE
'    .UserName = txtUserName                     ' Optional, default = Null String
'    .Password = txtPassword                     ' Optional, default = Null String, value is NOT saved
'    .POP3Host = txtPopServer
'    .MaxRecipients = 100                        ' Optional, default = 100, recipient count before error is raised
    
    ' **************************************************************************
    ' Advanced Properties, change only if you have a good reason to do so.
    ' **************************************************************************
    ' .ConnectTimeout = 10                      ' Optional, default = 10
    ' .ConnectRetry = 5                         ' Optional, default = 5
    ' .MessageTimeout = 60                      ' Optional, default = 60
    ' .PersistentSettings = True                ' Optional, default = TRUE
    ' .SMTPPort = 25                            ' Optional, default = 25

    ' **************************************************************************
    ' OK, all of the properties are set, send the email...
    ' **************************************************************************
    ' .Connect                                  ' Optional, use when sending bulk mail
    .Send                                       ' Required
    ' .Disconnect                               ' Optional, use when sending bulk mail
  End With
End Sub

Public Sub Send_EMail(strName As String, strSubject As String, strMessage As String, Optional strForm As String, _
                Optional MySendObjectType As Access.AcSendObjectType = acSendNoObject, Optional Do_not_ask As Boolean = True, _
               Optional OutputFormat As accSendObjectOutputFormat = accOutputHTML, Optional EditMessage = False, Optional CC As String, Optional BCC As String)
'New - General SMTP e-mail routine (all e-mail should go through this common routine)
If Not debugging Then
  On Error GoTo err_Send_EMail_SMTP
End If
  Dim clsSendObject As accSendObject
  Dim intResponse As Integer
  Dim strCommandLineParam As String
'  Dim strCC As String
  
  If IsNull(strName) Or strName = "" Then
    MsgBox "E-Mail address missing so E-Mail cannot be sent", vbInformation, "E-Mail Notice (MUI-24)"
    GoTo exit_Send_EMail_SMTP
  End If
  
'  Set clsSendObject = New accSendObject
  If Do_not_ask = False Then  'Ask
    intResponse = MsgBox("Press cancel if you DO NOT want an automated Email message to be sent to " & strName & vbNewLine & _
                         "  E-Mail Subject = " & strSubject _
                         , vbOKCancel, "User Input (MUI-25)")
    If intResponse = vbCancel Then  'If user doesn't want to send e-mail then exit
      GoTo exit_Send_EMail_SMTP
    End If
  End If
  strCommandLineParam = Trim(Command)  '7/6/09
'uncomment tbd  If strName = LoggedEmployeeEMail_Address And strCommandLineParam <> "Maintenance" Then  'Don't send e-mail to person logged in but send if maintenance updated 7/6/09
''    MsgBox "Email will not be sent to you because you made the entry", vbInformation, "User Notice (MUI-20)"
'uncomment  Else
    CC = "robert.schmitt@medtronic.com"  'for test
    Call SMTP_EMail_Sender(strName, strSubject, strMessage, , CC)
'Public Sub SMTP_EMail_Sender(strRecipient As String, strSubject As String, strMessage As String, Optional strForm As String, Optional strCC As String)
'uncomment  End If
exit_Send_EMail_SMTP:
  Exit Sub
err_Send_EMail_SMTP:
  If Err.Number = 2295 Or Err.Number = -2147221229 Then
    LogEvt "Email could not be sent to " & strName & ". You need to manually notify the person", vbInformation, "Warning (MUI-26)"
  Else
    LogEvt "Error Number " & Err.Number & vbNewLine & Err.Description, vbCritical, "Send_EMail_SMTP Error (MUI-27)"
    Resume exit_Send_EMail_SMTP
  End If
End Sub

Select all Open in new window