Late binding

[bmrsalgas]

Hi everyone...

I need help with the code that I am using.

It works great on adding reminders to outlook based on a excel sheet.

however when i use diferent versions of excel 2010 or 2013 or 2016 it gives the error because of the references.

Can anyone help me convert the code I am using into a code that works with late binding?

Public Sub CreateOutlookAppointments()   Sheets("Reminders").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 = 3
    Do Until Trim(Cells(i, 1).Value) = ""
     
    Set olAppt = CalFolder.Items.Add(olAppointmentItem)
           
    With olAppt
     
    'Define calendar item properties
        .Start = Cells(i, 7) + Cells(i, 8)
        .End = Cells(i, 7) + Cells(i, 10)
        .Subject = Cells(i, 1)
        .Location = Cells(i, 2)
        .Body = Cells(i, 3)
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = Cells(i, 11)
        .ReminderSet = True
        .Categories = Cells(i, 4)
        .Save
' For meetings or Group Calendars
     ' .Send
    End With
                 
        i = i + 1
        Loop
    Set olAppt = Nothing
    Set olApp = Nothing
     
    MsgBox "Reminders are on your calendar."
     
    Exit Sub
     
Err_Execute:
    MsgBox "An error occurred - Exporting items to Calendar."
     
End Sub

 

[RoryA]

This should work:

Public Sub CreateOutlookAppointments()
    Sheets("Reminders").Select
    On Error GoTo Err_Execute
     
    Dim olApp As Object ' Outlook.Application
    Dim olAppt As Object ' Outlook.AppointmentItem
    Dim blnCreated As Boolean
    Dim olNs As Object ' Outlook.Namespace
    Dim CalFolder As Object ' Outlook.MAPIFolder
    Dim i As Long
    
    ' OUTLOOK constants need to be declared
    Const olFolderCalendar As Long = 9
    Const olAppointmentItem As Long = 1
    
    
    On Error Resume Next
'    Set olApp = Outlook.Application
    Set olApp = GetObject("Outlook.Application")
     
    If olApp Is Nothing Then
        Set olApp = CreateObject("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 = 3
    Do Until Trim(Cells(i, 1).Value) = ""
     
    Set olAppt = CalFolder.Items.Add(olAppointmentItem)
           
    With olAppt
     
    'Define calendar item properties
        .Start = Cells(i, 7) + Cells(i, 8)
        .End = Cells(i, 7) + Cells(i, 10)
        .Subject = Cells(i, 1)
        .Location = Cells(i, 2)
        .Body = Cells(i, 3)
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = Cells(i, 11)
        .ReminderSet = True
        .Categories = Cells(i, 4)
        .Save
' For meetings or Group Calendars
     ' .Send
    End With
                 
        i = i + 1
        Loop
    Set olAppt = Nothing
    Set olApp = Nothing
     
    MsgBox "Reminders are on your calendar."
     
    Exit Sub
     
Err_Execute:
    MsgBox "An error occurred - Exporting items to Calendar."
     
End Sub

 

[bmrsalgas]

worked in perfection!!! Thanks you saved my excel life

 

[RoryA]

Glad to help.