Send Outlook Meeting Invitation using Excel

Question

I am looking to send meeting invitations for each row in a worksheet.

I am able to create an item that when displayed shows as an appointment, not a meeting request that

Answer 1

I realized the issue. The cell I was linking to for the emails contained a formula instead of the email address text. Once I changed the email addresses to text instead of a formula my VBA worked perfectly.

Answer 2

I had the same problem as the OP but rather than resort to send keys I used the inspector to access the Invite Attendees ribbon command. Here are excerpts from the code:

Dim oApp As Object
Dim OutMail As Object
Dim oCommandBar As Object 'Office.CommandBars
Dim oInsp As Object 'Outlook.inspector
        
Set outMail = oApp.CreateItem(1)

'then these in the loop to get access to the ribbon:

Set oInsp = OutMail.GetInspector
Set oCommandBar = oInsp.CommandBars

'Show the mail item
outMail.display

'Press the Invite attendees ribbon item
oCommandBar.ExecuteMso ("InviteAttendees")

Answer 3

Try this?

Sub SendAction()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

For Each cell In Worksheets("Action Log").Range("H5:H50").Cells
    Set OutMail = OutApp.CreateItem(1)
    If cell.Value Like "*@*" Then      'try with less conditions first
        With OutMail
            .MeetingStatus = olMeeting
            .RequiredAttendees = Cells(cell.Row, "H").Value
            .RequiredAttendees.Type = olRequired
            .Subject = Cells(cell.Row, "I").Value
            .Body = Cells(cell.Row, "I").Value
            .Start = Cells(cell.Row, "E").Value & " " & TimeValue("8:00 AM")
            .Location = "Your Office"
            .Duration = 15 ' 15 minute meeting
            .BusyStatus = 0 ' set as free
            .ReminderSet = True 'reminder set
            .ReminderMinutesBeforeStart = "20160" 'reminder 2 weeks before
            .display
            .send

        End With

        Cells(cell.Row, "K").Value = "sent"
        Set OutMail = Nothing
    End If
Next cell

Application.ScreenUpdating = True

End Sub