VBA excel dates to outlook meetings - ignore blank cells

[Yosepht]

Hey everyone,

I'm having a lot of trouble getting my head around VBA and I'm very stuck on this particular issue.
The code does excatly what i need it to, up until " Set RequiredAttendee = .Recipients.Add(Cells(i, 7).Value) " where some of the cells in that range are blank and I need it to ignore and still continue the operation.

I get "Run-Time Error: There must be at least one name or contact group in the To, Cc or Bcc box. Which stops the entire process.

Sorry if this is not how to post a problem as i'm new here.

Public Sub CreateOutlookAppointments()
   Sheets("sheet1").Select
    On Error GoTo Err_Execute
    
    Dim olApp As Outlook.Application
    Dim olAppt As Outlook.AppointmentItem
    Dim blnCreated As Boolean
    Dim olNs As Outlook.Namespace
    Dim CalFolder As Outlook.MAPIFolder
    
    Dim i As Long
    
    On Error Resume Next
    Set olApp = Outlook.Application
    
    If olApp Is Nothing Then
        Set olApp = Outlook.Application
         blnCreated = True
        Err.Clear
    Else
        blnCreated = False
    End If
    
    On Error GoTo 0
    
    Set olNs = olApp.GetNamespace("MAPI")
    Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)
        
    i = 2
    Do Until Trim(Cells(i, 1).Value) = ""
    
    Set olAppt = CalFolder.Items.Add(olAppointmentItem)
    With olAppt
       .MeetingStatus = olMeeting
    'Define calendar item properties
        .Subject = Cells(i, 1)
        .Start = Cells(i, 3)
        .Categories = Cells(i, 4)
        .Body = Cells(i, 5)
        .AllDayEvent = True
        .BusyStatus = olFree
        .ReminderMinutesBeforeStart = 2880
        .ReminderSet = True
' get the recipients
        Dim RequiredAttendee As Outlook.Recipient
        Set RequiredAttendee = .Recipients.Add(Cells(i, 7).Value)
            RequiredAttendee.Type = olRequired
        .Display
    End With
        
        i = i + 1
        Loop
    Set olAppt = Nothing
    Set olApp = Nothing
    
    Exit Sub
    
Err_Execute:
    MsgBox "An error occurred - Exporting items to Calendar."
    
End Sub
' Above works for meetings but crashes when encountering empty recipient.

 

[Domenic]

Sorry, I don't understand, can you please elaborate?

 

[Yosepht]

Hi, again Domenic!

Sorry, let me rephrase. I have other appointments that need adding to my outlook calendar in the same table (e.g. Rows 14 & 15 below), however, the VBA currently only creates .olmeeting for appointments with attendees labelled.

How do I adapt the current code to add appointments that do not have attendees in column "F" to my outlook calendar as a personal appointment, while avoiding past dates in column C?

I hope this is a little clearer!

 

[Domenic]

To create appointments for dates that are greater than or equal to today's date, and where there are no recipients specified, replace...

If startDate >= Date And Len(theRecipients) > 0 Then

with

If startDate >= Date And Len(theRecipients) = 0 Then