Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
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
Optional strMailServer As String = "YourEmailServerName")
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