[LIST=1]
[*]Public 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 = "10.2.0.32")
[*] On Error GoTo ErrHandler
[*] Dim email As New CDO.Message
[*] 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("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
[*] 'Name or IP of Remote SMTP Server
[*] .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer
[*] 'Type of authentication, NONE, Basic (Base64 encoded), NTLM
[*] .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/authenticate") = 0
[*] 'Your UserID on the SMTP server
[*] .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strNTUserName
[*] 'Your password on the SMTP server
[*] .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strNTUserPwd
[*] 'Server port (typically 25)
[*] .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
[*] 'Use SSL for the connection (False or True)
[*] .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
[*] 'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
[*] .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
[*] .Configuration.Fields.Update
[*] .Send
[*] End With
[*] ExitProcedure:
[*] Exit Function
[*] ErrHandler:
[*] Err.Raise Err.Number, "Mail_SMTP", "An the following error occurred while attempting " & _
[*] "to send mail via Mail_SMTP." & vbCrLf & "Error Number: " & Err.Number & _
[*] vbCrLf & vbCrLf & "Error Description: " & vbCrLf & Err.Description
[*] Resume ExitProcedure
[*] End Function
[/LIST]