VBA Application-defined error outlook connection

Question

I have the following code and keep having the error "application-defined or object-defined error" and cannot understand why. The tool Microsoft Office 16.0 Object library is activated, I am confident that the error is liked with the line Set outlookMail = outlookApp.CreateItem(0). For sure I am missing something in the connection with outlook.

Sub send_emails()

Dim outlookApp As Object
Dim outlookMail As Object
Dim cell As Range
Dim lastRow As Long

' Create Outlook object
Set outlookApp = CreateObject("Outlook.Application")

' Determine the last row in the worksheet
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

' Loop through each cell in column D
For Each cell In Range("D2:D" & lastRow)
  
  ' Check if the date in the cell is 15 days from today
  If cell.Value = Date + 15 Then
    
    ' Retrieve the corresponding email address, name, and surname
    Email = cell.Offset(0, 2).Value
    Name = cell.Offset(0, 1).Value
    surname = cell.Offset(0, -1).Value
    
    ' Create a new email
    Set outlookMail = outlookApp.CreateItem(0)
    
    ' Set the recipient, subject, and body of the email
    outlookMail.To = Email
    outlookMail.Subject = "Reminder"
    outlookMail.Body = "Dear " & Name & " " & surname & ", this is a reminder that your event is coming up in 15 days. Please make sure to prepare accordingly."
    
    ' Set the sender and send the email
    outlookMail.SendUsingAccount = outlookApp.Session.Accounts.Item("YOUR EMAIL ADDRESS")
    outlookMail.Send
    
    ' If the email was sent successfully, color the cell in column E green
    cell.Offset(0, 1).Interior.Color = vbGreen
  End If
Next cell

' Clean up
Set outlookMail = Nothing
Set outlookApp = Nothing

End Sub

Answer 1

The tool Microsoft Office 16.0 Object library is activated

I suppose you have added a reference to the Outlook object model (a COM reference) in Excel VBA environment. In the code I see that the late-binding technology is used:

Dim outlookApp As Object
Dim outlookMail As Object
' Create Outlook object
Set outlookApp = CreateObject("Outlook.Application")

But at the same time you added a COM object reference for using the early-binding in the code. So, I'd suggest using the New operator and declare all Outlook objects in the code with specific types instead:

Dim outlookApp As Outlook.Application
Dim outlookMail As Outlook.MailItem

Set outlookApp = New Outlook.Application()

You can read more about early and late binding technologies in the Using early binding and late binding in Automation article.

Answer 2

Send Emails From Excel

Option Explicit

Private Enum eCols
    ecSurName = 1 ' C
    ecDate = 2 ' D
    ecName = 3 ' E
    ecEmail = 4 ' F
End Enum

Sub SendEmails()
    
    Const MY_EMAIL As String = "YOUR EMAIL ADDRESS"
    
    On Error GoTo ClearError
    
    ' Reference the worksheet.
    
    If ActiveSheet Is Nothing Then Exit Sub ' no visible workbooks open
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    ' Reference the range.
    
    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    If LastRow < 2 Then Exit Sub ' no data
    Dim rg As Range: Set rg = ws.Range("C2", ws.Cells(LastRow, "F"))
    
    ' Write the values from the range to an array.
    
    Dim Data(): Data = rg.Value
    
    ' Write the matching rows to a collection.
    
    Dim coll As Collection: Set coll = New Collection
    
    Dim r As Long, rDate As Variant
    
    For r = 1 To UBound(Data, 1)
        rDate = Data(r, eCols.ecDate)
        If IsDate(rDate) Then
            If rDate = Date + 15 Then coll.Add r
        End If
    Next r
    
    If coll.Count = 0 Then Exit Sub ' no matches
    
    ' Send the emails.
    
    Dim olApp As Object: Set olApp = CreateObject("Outlook.Application")
    
    Dim crg As Range, rItem, ErrNum As Long, emCount As Long
    Dim olMail As Object, mEmail As String, mName As String, mSurName As String
    
    For Each rItem In coll
        
        mEmail = Data(rItem, eCols.ecEmail)
        mName = Data(rItem, eCols.ecName)
        mSurName = Data(rItem, eCols.ecSurName)
        
        Set olMail = olApp.CreateItem(0)
        
        With olMail
            .To = mEmail
            .Subject = "Reminder"
            .Body = "Dear " & mName & " " & mSurName _
                & ", this is a reminder that your event is coming up " _
                & "in 15 days. Please make sure to prepare accordingly."
            .SendUsingAccount = olApp.Session.Accounts.Item(MY_EMAIL)
            On Error Resume Next ' suppress send error e.g. if invalid email
                olMail.Send
                ErrNum = Err.Number
            On Error GoTo ClearError
        End With
        
        ' Count and combine cells to be highlighted.
        If ErrNum = 0 Then
            emCount = emCount + 1
            If crg Is Nothing Then
                Set crg = rg.Cells(rItem, eCols.ecName)
            Else
                Set crg = Union(crg, rg.Cells(rItem, eCols.ecName))
            End If
        End If
    
    Next rItem
    
ProcExit:
    On Error Resume Next
        ' Highlight cells.
        If Not crg Is Nothing Then crg.Interior.Color = vbGreen
        ' Clean up.
        If Not olMail Is Nothing Then Set olMail = Nothing
        If Not olApp Is Nothing Then Set olApp = Nothing
        ' Inform.
        MsgBox IIf(emCount = 0, "No", emCount) & " email" _
            & IIf(emCount = 1, "", "s") & " sent.", _
            IIf(emCount = 0, vbExclamation, vbInformation)
    On Error GoTo 0
Exit Sub

ClearError:
    Debug.Print "Run-time error '" & Err.Number & "':" & Err.Description
    Resume ProcExit
End Sub