' 1 2 3 4 5 6 7 8 ' ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' * * ' * Name: SendEmail File Name: Form1.frm * ' * * ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' * * ' * PURPOSE: To send an E-mail with or without attachments * ' * * ' * GIVEN: emailMode = e-mail message sub-system to be used * ' * in sending the e-mail * ' * 1 : CDO, 2 : MAPI * ' * strSender = Sender's e-mail address * ' * strRecipient = Recipient e-mail address * ' * strSubject = e-mail subject line * ' * strBody = e-mail message * ' * strType = e-mail message format type * ' * 1 : plain ASCII text * ' * 2 : HTML text * ' * strCc = Cc e-mail address * ' * strBcc = Bcc e-mail address * ' * colAttachments = list of file attachmets * ' * * ' * RETURN: sentOkay = status flag indicating if the e-mail * ' * was sent okay * ' * (true = no error, false = error) * ' * errString = error message, if there is no error, * ' * this variable will be equal to "" * ' * * ' * NOTE: (a) If using MAPI, HTML formatted e-mails will not * ' * come across as expected, need to use CDO if going * ' * to send HTML formatted e-mails * ' * (b) Using MAPI is much faster than CDO * ' * (c) If sending HTML with embedded images, the images * ' * need to reside on the web in order for them to be * ' * included in the e-mail, for example: * ' * * ' * * ' * Dim emailMode As Integer * ' * Dim strSender As String * ' * Dim strRecipient As String * ' * Dim strSubject As String * ' * Dim strBody As String * ' * Dim strCc As String * ' * Dim strBcc As String * ' * Dim colAttachments As New Collection * ' * Dim sentOkay As Boolean * ' * Dim errString As String * ' * * ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' Public Sub SendEmail(ByVal emailMode As Integer, _ ByVal strSender As String, _ ByVal strRecipient As String, _ ByVal strSubject As String, _ ByVal strBody As String, _ ByVal strType As Integer, _ ByVal strCc As String, _ ByVal strBcc As String, _ ByVal colAttachments As Collection, _ sentOkay As Boolean, errString As String) ' Dim Flds Dim cdoConf As New cdo.Configuration Dim cdoMsg As New cdo.Message Dim attachment Dim ii As Long, kk As Long ' ' ---Handle any errors that may occur On Error GoTo Errorhandler ' ' ---Initialize the error string to be passed back (no error) errString = "" ' ' ---Set flag denoting error in sending the E-mail sentOkay = False ' ' --- ' ---Check if CDO is to be used ' ---Note, the Microsoft CDO for Exchange 2000 Library must be loaded ' ---with the {Project} [References...] menu item ' --- If (emailMode = 1) Then ' ' ---Define the configuration information for the remote SMTP server ' ' ---Parameter Description ' ' ---sendusing 1 : Send message using the local SMTP ' --- service pickup directory ' --- 2 : Send message using the network ' --- (SMTP over the network) ' ---smtpserver Name or IP of Remote SMTP Server ' ---smtpserverport Server port (typically 25, although it ' --- could be another value such as 5190) ' ---sendusername UserID on the SMTP server ' ---sendpassword Password on the SMTP server ' ---smtpauthenticate 0 : Do not authenticate ' --- 1 : basic (clear-text) authentication ' --- 2 : NTLM ' ---smtpusessl Use SSL for the connection (False or True) ' --- Indicates whether Secure Sockets Layer (SSL) ' --- should be used when sending messages using ' --- the SMTP protocol over the network, use ' --- this parameter only if sendusing = 2 ' ---smtpconnectiontimeout Connection Timeout in seconds (the maximum ' --- time CDO will try to establish a connection ' --- to the SMTP server, i.e. 60) ' Set Flds = cdoConf.Fields With Flds If (emailService) Then .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 1 Else .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 End If .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = emailSMTPServer .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = emailSMTPPort .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = emailUserName If (Len(Trim(emailPassword)) > 0) Then .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = emailPassword End If .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = emailUseSSL .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = emailTimeout .Update End With ' ' ---Apply the settings to the message With cdoMsg Set .Configuration = cdoConf .To = strRecipient .From = strSender .Subject = strSubject If (strType = 1) Then ' ---Set flag denoting e-mail message contains ' ---plain ASCII text .TextBody = strBody Else ' ---Set flag denoting e-mail message contains ' ---HTML text .HTMLBody = strBody End If If Not colAttachments Is Nothing Then ' ---Add all of the attachments to the e-mail For Each attachment In colAttachments .AddAttachment attachment Next End If If strCc <> "" Then .CC = strCc If strBcc <> "" Then .BCC = strBcc ' ---Send the E-mail .Send End With ' ' ---Dereference the objects Set cdoMsg = Nothing Set cdoConf = Nothing Set Flds = Nothing ' ' ---Set flag denoting no error was detected sentOkay = True ' ' --- ' ---Handle case when MAPI is to be used ' ---Note, the Microsoft MAPI Controls 6.0 must be loaded ' ---with the {Project} [Components...] menu item ' --- Else ' ' ---In Visual Basic, the MAPI controls are used to interact with ' ---the underlying message subsystem. To use these controls, you ' ---must first install a MAPI-compliant e-mail system like ' ---Microsoft Exchange. The underlying messaging services are ' ---provided by the workgroup environment — the Microsoft Exchange ' ---Server running under Windows 95 (or later). ' ' ---Notes: ' ---1. The From: address component in an E-mail is taken from the ' --- Address book that is used as the E-mail service. Eudora ' --- users can define this using the {Tools} [Options...] ' --- command under the Getting Started category with the ' --- Real Name parameter, ' ---2. Eudora users can disable under the MAPI category the ' --- Warn on MAPI auto-send of messages option to get rid of the ' --- warning message which will appear when an E-mail is sent ' --- using MAPI ' ' ---The DownloadMail property specifies whether the user's mail ' ---will be downloaded at the beginning of the current session ' ---automatically. Setting this value to True will download all ' ---the user's mail to their Inbox. Depending upon the mail system ' ---and the amount of incoming mail, this can be a processing- ' ---intensive operation. By setting this property to False, the ' ---user can choose to download mail at a later time or set the ' ---interval at which mail is automatically downloaded. ' ' ---The LogonUI property when set to True will provide the user ' ---with the sign-on dialog box of the underlying mail system. ' ---If such a dialog box does not exist, this property will be ' ---ignored. You can create a custom dialog box to prompt the ' ---user for this information. ' ' ---The SignOn method begins the MAPI session ' ' ---The NewSession property specifies whether a new mail session ' ---should be established. If a valid session is already ' ---established, setting the NewSession property will allow two ' ---sessions to run concurrently. ' ' ---The SessionID property contains the session handle when a ' ---new session is established. Depending upon the value of the ' ---NewSession property, the session handle may refer to a newly ' ---created session or an existing session. ' ' ---The UserName and Password properties are used to provide a ' ---valid sign-on to the underlying messaging system. You can ' ---either set these properties at design time or prompt the ' ---user at run time. With MAPISession1 .DownLoadMail = False .LogonUI = True .SignOn .NewSession = True MAPIMessages1.SessionID = .SessionID .UserName = strSender End With ' With MAPIMessages1 ' ---Check if any attachments are to be included If (colAttachments.Count > 0) Then ' ---Set flag that attachments are to be included .MsgIndex = -1 End If .Compose .RecipAddress = strRecipient .AddressResolveUI = True .ResolveName .MsgSubject = strSubject .MsgNoteText = strBody If (colAttachments.Count > 0) Then ' ---Add all of the attachments to the e-mail ii = -1 For kk = 1 To colAttachments.Count ii = ii + 1 .AttachmentIndex = ii .AttachmentPathName = colAttachments.Item(kk) Next End If ' ---Send the E-mail setting the optional parameter to False, ' ---setting it to True places the Compose dialog box on the ' ---screen; while setting it to False hides that box .Send False End With ' ' ---Terminate or end the MAPI session With MAPISession1 .SignOff End With ' ' ---Set flag denoting no error was detected sentOkay = True End If ' ' ---Our work is done Exit Sub ' ' ---Handle any errors that were detected Errorhandler: ' ' ---Set flag denoting error in sending the E-mail sentOkay = False ' ' ---Get the error message that was detected errString = Err.Description ' ' ---Get rid of the CR and LF characters in the error message errString = Replace(errString, Chr(13), "") errString = Replace(errString, Chr(10), "") ' End Sub