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.
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.
VBA Code:
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.