TheSearcher
Registered User.
- Local time
- Today, 18:22
- Joined
- Jul 21, 2011
- Messages
- 304
I wrote the following email routine. The emails are sent and received perfectly without any issues. I'm using the sendTLS method for encryption. However, there is so much conflicting information on the web about its effectiveness. Some suggest using the UseSSL method instead. Regardless of which method I use there is no visible evidence that anything in encrypted. They seem to come through as regular emails. Does anyone know whether my code actually encrypts the emails?
Code:
Public Sub CDOMail(ByVal Email_Code As String)
'*** The purpose of this email routine is to bypass Outlook completely so that the user doesn't get that annoying message stating
'*** "A program is trying to send an e-mail message on your behalf..."
Dim mail As CDO.MESSAGE
Dim config As CDO.Configuration
Set mail = CreateObject("CDO.Message")
Set config = CreateObject("CDO.Configuration")
config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
config.Fields(cdoSMTPServer).Value = "mycompany-com.mail.protection.outlook.com"
config.Fields(cdoSMTPServerPort).Value = 25
'*** Encryption - Both config.Fields statements below will work. I chose to use the sendtls command.
'config.Fields(cdoSMTPUseSSL).Value = True
config.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendtls").Value = True
config.Fields.Update
Set mail.Configuration = config
With mail
.To = Globals.glb_EmailString
.From = Globals.glb_Email
.Subject = "INCIDENT REPORT"
If Email_Code = "A" Then 'If after director signed then send attachment.
.AddAttachment Globals.glb_OutputFileLocation
.TextBody = "An Incident Report has been created for " & Globals.glb_Client & ". Please see attached file." & Chr(13) & Chr(13)
Else
.TextBody = "An Incident Report has been created for " & Globals.glb_Client & ". Please review it by clicking on the Director's button in the Incident Reports program." & Chr(13) & Chr(13)
End If
.Send
End With
Set config = Nothing
Set mail = Nothing
Globals.glb_EmailString = ""
End Sub