Hello!
I recently upgraded my Outlook to 2016, and I am now receiving an error when I send out reminder emails to my tenants. The error seems to occur in the .Send area of the code provided below. Also, this error only occurs with email addresses that contain a period (i.e. Katrina.M.LastName@company.com)
Private Sub RUN Click()
' Open a recordset on the expiring contracts
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT * FROM [INS TBL] WHERE [SEND EMAIL] = True")
' Loop through them all
Do Until rst.EOF
' Make sure we have a valid email
If Not IsNull(rst![VENDOR E-MAIL]) Then
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Create the! Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(rst![VENDOR E-MAIL])
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(rst![E-MAIL])
objOutlookRecip.Type = olCC
' Add the BCC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(rst![FINANCE EMAIL])
objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "Certificate of Insurance Expire Date Approaching"
.Body = "ATTN: " & " " & rst![CONTACT PERSON] & &! quot; " & _
& n! bsp; "-" & vbCrLf & vbCrLf & "Please be advised that the Certificate of Insurance for " & "" & rst![VENDOR NAME] & " has expired or will expire on " & _
rst![CERTIFICATE EXPIRATION DATE] & _
"." & vbCrLf & vbCrLf & "Please submit renewed Certificate of Insurance as soon as possible. If you have any questions, please contact me. Your cooperation is greatly appreciated." & vbCrLf & vbCrLf & "Thank you." &! vbCrLf & vbCrLf &
.Importance = olImportanceHigh 'High importance
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End If
' Get the next one
rst.MoveNext
Loop
' Close out
rst.Close
Set rst = Nothing
Set db = Nothing
End Sub
Any help on how to resolve this error is greatly appreciated!!!
Thanks!
Kat