Option Explicit
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) = ""

' check if previously imported
 If Trim(Cells(i, 11).Value) = "" Then    
 
   Set olAppt = CalFolder.Items.Add(olAppointmentItem)
    With olAppt
       .MeetingStatus = olMeeting
    'Define calendar item properties
        .Subject = Cells(i, 1)
        
    ' doni use location if using a resource
       ' .Location = Cells(i, 2)
        .Body = Cells(i, 3)
        .Categories = Cells(i, 4)
        .Start = Cells(i, 5) + Cells(i, 6)     '+ TimeValue("9:00:00")
        .End = Cells(i, 7) + Cells(i, 8)       '+TimeValue("10:00:00")
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = Cells(i, 9)
        .ReminderSet = True

' get the recipients
        Dim RequiredAttendee, OptionalAttendee, ResourceAttendee As Outlook.Recipient
        Set RequiredAttendee = .Recipients.Add(Cells(i, 10).Value)
            RequiredAttendee.Type = olRequired
        Set OptionalAttendee = .Recipients.Add(Cells(i, 11).Value)
            OptionalAttendee.Type = olOptional
        Set ResourceAttendee = .Recipients.Add(Cells(i, 12).Value)
            ResourceAttendee.Type = olResource
' For meetings or Group Calendars
        .Send
        
    End With

' mark as imported
Cells(i, 11) = "Imported"
End If
       
        i = i + 1
        Loop
    Set olAppt = Nothing
    Set olApp = Nothing
     
    Exit Sub
     
Err_Execute:
    MsgBox "An error occurred - Exporting items to Calendar."
     
End Sub