[AccessD] Generic Code for SMTP Email Using vbSendMail

Hope this is helpful!

Any Comments?

Dan Waters

__________________________________________________________________________

Private Sub SendEmailGeneric()

    '-- This would come from a form or standard module
    Call SendEmailSMTPGeneric("Dan Waters", "Problem 912 is now assigned to
you.", "frmProblemMain", "NotifyAssignee", "The Problem Description is . .
.", "C:\Problems\Problem 912.doc", , True, True)

End Sub

Public Sub SendEmailSMTPGeneric(stgTo As String, _
    Optional stgSubject As String, _
    Optional stgForm As String, _
    Optional stgProcedure As String, _
    Optional stgMessage As String, _
    Optional stgAttachment As String, _
    Optional stgRecordNumber As String, _
    Optional blnSendToCurrent As Boolean, _
    Optional blnHideEmailNotice As Boolean)
    
On Error GoTo EH

    Dim poSendMail As Object
    Dim stgFromEmailAddress As String
    Dim blnShowEmailMessage As Boolean
    Dim stgCurrentMachineName As String
    Dim stgSystemAcronym As String

    If IsNull(stgTo) Then
        Exit Sub
    End If

    If stgTo = "" Then
        Exit Sub
    End If

    stgCurrentMachineName = CurrentPCName
    
    '-- Each customer can have their own System Acronym
    stgSystemAcronym = SystemAcronym

    '-- Normally don't send an email to the person currently logged on
    If blnSendToCurrent = False Then
        If stgTo = CurrentPerson Then
            Exit Sub
        End If
    End If
    
    '-- Get the current user's email address
    stgFromEmailAddress = EmailAddressUserName(CurrentUser)
        
    '-- Get separate email addresses for each person in the stgTo list. _
        Modular variables are used - could also be Functions
    MstgAllAddresses = ""
    MstgTo = ""
    Call GetSeparateEmailAddresses(stgTo)
    If MstgTo = "" Then
        Exit Sub
    End If
    
    '-- Late Binding
    Set poSendMail = CreateObject("vbSendMail.clsSendMail")
    
    '-- Get the SMTP Name (provided by customer)
    poSendMail.SMTPHost = SMTPServerName
    
    '-- Set the From Display Name as being from the system instead of from a
person
    poSendMail.FromDisplayName = SystemAcronym & " Notification"
    
    '-- The sending person's email address is recorded, but isn't all that
obvious
    poSendMail.FROM = stgFromEmailAddress
    poSendMail.ReplyToAddress = stgFromEmailAddress
    
    '-- Add a message if there is one
    If stgMessage <> "" Then
        poSendMail.Message = stgMessage
    End If
    
    '-- Multiple attachments can be sent
    If Not IsEmpty(stgAttachment) And stgAttachment <> "" Then
        poSendMail.Attachment = stgAttachment
    End If
    
    '-- Define recipients' email addresses
    poSendMail.RecipientDisplayName = MstgTo
    poSendMail.Recipient = MstgAllAddresses
    poSendMail.Subject = stgSubject
    
    '-- When email is originated from the developer's PC, don't actually
send email
    If stgCurrentMachineName <> "DanWaters" Then
        poSendMail.Connect
        poSendMail.Send
        poSendMail.Disconnect
    End If
    
    '-- Does this user want to see email messages?
    blnShowEmailMessage = ShowEmailMessages
    
    '-- Display an 'Email Sent' message for various circumstances
    If blnShowEmailMessage = True And stgProcedure <> "UserLicenses" And
stgProcedure <> "DeveloperEmail" And blnHideEmailNotice = False Then
        If InStr(MstgTo, "@") <> 0 Then
            MsgBox "Email To: " & MstgTo & vbNewLine & vbNewLine & "Subject:
" & stgSubject, vbOKOnly, "Email Sent Notice"
        Else
            FormattedMsgBox GstgReminder, "Email To: " & MstgTo & vbNewLine
& vbNewLine & "Subject: " & stgSubject & "@ @", vbOKOnly, "Email Sent
Notice"
        End If
    End If
        
    Exit Sub

EH:
    Application.Echo True
    Call GlobalErrors("", Err.Number, Err.Description, "Email SMTP Generic",
"SendEmailSMTPGeneric", stgForm & ": " & stgRecordNumber, stgProcedure,
"Line " & Erl)

End Sub