Sending Massive emails on excel vba, OLE issue

I hope you're doing great.

I'm using this code to send emails in VBA Excel, but it only works one time, then I have to close Outlook on Task manager. If I don't do this, I get a message that says "Microsoft Excel is waiting for another application to complete an OLE action". The only thing I have to do is close the outlook app on the task manager, and then it works perfectly fine.

Could you please help me fix this issue please? Below I'll post my code

Dim email As Outlook.MailItem
Dim direc As String
Dim body As String
Set A = New Outlook.Application

For i = 2 To ActiveSheet.Cells(Rows.Count, 16).End(xlUp).Row
direc = Worksheets("NewSheet").Cells(i, 16).Value

Set email = A.CreateItem(emailItem)
    With email
    direc = Worksheets("NewSheet").Cells(i, 16).Value
        If (direc <> "0") Then
            .To = direc
            .Subject = "Notification Test"
            body = Worksheets("NewSheet").Cells(i, 14)
            .HTMLBody = "<HTML><BODY style=font-size:11pt;font-family:Calibri>This is a notification reminder to let you know that you have <b>" & body & "</b> open contact(s) that you must Update</BODY><br><br>Best Regards, </br></br><br> Anonymous </br></HTML>"
            .Display
            .Send
        End If
    End With
Next i

Thank you so much for your time and help.

Solution

I'd suggest trying to run the code in Outlook VBA environment to make sure the issue is not related to security issues when sending emails. The fact is that the Outlook object model generates security issues or give security prompts to users when protected properties or methods are called using automation. Or just may try to call Save instead of Send in the following way:

Set email = A.CreateItem(emailItem)
    With email
    direc = Worksheets("NewSheet").Cells(i, 16).Value
        If (direc <> "0") Then
            .To = direc
            .Subject = "Notification Test"
            body = Worksheets("NewSheet").Cells(i, 14)
            .HTMLBody = "<HTML><BODY style=font-size:11pt;font-family:Calibri>This is a notification reminder to let you know that you have <b>" & body & "</b> open contact(s) that you must Update</BODY><br><br>Best Regards, </br></br><br> Anonymous </br></HTML>"
            .Save
        End If
    End With
Next i

If this code works correctly than a security issue is the case.

The Send method may fire an exception when you try to automate Outlook. In this case most probably you are faced with an Outlook security issue. It can also be a prompt issued by Outlook if you try to access any protected property or method. But in your case that can be an exception or error. You get the security prompts/exceptions because Outlook is configured on the client computer in one of the following ways:

Uses the default Outlook security settings (that is, no Group Policy set up)
Uses security settings defined by Group Policy but does not have programmatic access policy applied
Uses security settings defined by Group Policy which is set to warn when the antivirus software is inactive or out of date

You can create a group policy to prevent security prompts from displaying if any up-to-date antivirus software is installed on the system or just turn these warning off (which is not really recommended).

Read more about that in the Security Behavior of the Outlook Object Model article.

Also you may consider using a low-level code on which Outlook is built and which doesn't give security issues - Extended MAPI. Consider using any third-party wrappers around that API such as Redemption.

Another option would be the Outlook Security Manager which allows suppressing Outlook security issues at runtime on the fly.