take multiple emails from a single cell in column and send an Outlook calendar invitation from that cell

[Auri]

Hi, I've been developing this for the past 2 weeks with lots of help and I am stuck with these codes now. And I am not sure is this correct.

Sub EnterInCalendar()
Dim xOutApp As Object, cel As Range
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String

If Selection.Columns.Count > 1 Or Selection.Column <> 3 Then
    MsgBox "Select in column C only."
    Exit Sub
End If

Set xOutApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0) 'empty email

For Each cel In Selection
    With xOutApp.CreateItem(1)
        .Subject = cel.Value
        .Start = cel(1, 4).Value + TimeValue("9:00:00")
        .End = cel(1, 4).Value + TimeValue("9:30:00")
        .ReminderSet = True
        .ReminderMinutesBeforeStart = 10080
        .BusyStatus = 5
        .Save
    End With
    
    'Using the email, add multiple recipients, using a list of addresses in column J.
    With olMailItm
       SDest = ""
       For iCounter = 10 To WorksheetFunction.CountA(Columns(10))
           If SDest = "" Then
               SDest = Cells(iCounter, 10).Value
           Else
               SDest = SDest & ";" & Cells(iCounter, 10).Value
           End If
       Next iCounter
       'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
       .BCC = SDest
       .Subject = "FYI"
       .Body = ActiveSheet.TextBoxes(1).Text 'Not sure what this line does
       .Send
   End With
       
    Cells(cel.Row, "K") = "c"
Next

Set xOutApp = Nothing
Set olMailItm = Nothing
End Sub

When I run it,

Set olMailItm = olApp.CreateItem(0) 'empty email

that line will appear to have an error saying objects required.
So I would need help once again, any help would be really appreciated! Thanks!

 

[Auri]

Right now is currently taking the entire column instead of the row which is being selected. Any ideas on how to fix it?