I developed a VBA program to send email from an Office365 email account using CDO code.
The mail is triggered by the workbook.close
event.
It requires an active internet connection. In the case of no internet connection it throws an error message.
If the internet connection is not available, the workbook has to closed and the composed mail has to be stored in the outbox/draft or any other way possible in Office365 account, to be sent once the internet connection becomes available.
Sub send_mails1()
Dim objMessage, objConfig, Fields
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set objMessage = CreateObject("CDO.Message")
Set objConfig = CreateObject("CDO.Configuration")
Set Fields = objConfig.Fields
Set wb = ThisWorkbook
Set ws01 = wb.worksheets("DB_1")
datedifferance = ws01.Cells(Rows.Count, 10).End(xlUp).Row
With Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "from@domain.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxx"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendtls") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update
End With
Set objMessage.Configuration = objConfig
With objMessage
.Fields("urn:schemas:httpmail:importance") = 2
.Fields.Update
.Subject = "NPD Weekly Status-Notification"
.From = "from@domain.com"
.To = "to@domain.com"
.HTMLBody = "<font face=Calibri> <p style=font-size:12pt>" & _
"Dear Sir,<br/>" & _
"<br />" & _
"Please find the deviation in Plan vs Actual date,<br/>" & _
"<font face=Calibri> <p style=font-size:12pt>" & _
"Note:Please refer the attached log file(s) for more information. <br/>" & vbNewLine & _
"*This is system generated mail. Do not reply.<br/>"
If ws1mailstatus = True Then
.AddAttachment filename0
Kill (filename0)
End If
If ws2mailstatus = True Then
.AddAttachment filename1
Kill (filename1)
End If
If ws3mailstatus = True Then
.AddAttachment filename2
Kill (filename2)
End If
If ws4mailstatus = True Then
.AddAttachment filename3
Kill (filename3)
End If
If ws5mailstatus = True Then
.AddAttachment filename4
Kill (filename4)
End If
End With
On Error Resume Next
objMessage.Send
If Err.Number <> 0 Then
msgbox ("Error!")
End If
On Error GoTo 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub