Convert early binding to Late binding for code that creates outlook event from excel in VBA

rouzacct

Board Regular
Joined
Aug 31, 2010
Messages
65
Hello
I have this code that works perfectly fine until I open it on a different computer
so
I need to convert this code to Late Binding so that any version of office would still run the code without the references added in.


The code is to make appointments in outlook's calendar based on some columns that have the info needed to make the event

Code:
Option ExplicitSub CreateOutlookApptz()


     
    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 subFolder As Outlook.MAPIFolder
    Dim arrCal As String
    Dim i As Long
        
    Sheets("Sheet1").Select
    
   ' On Error GoTo Err_Execute
    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) = ""
    arrCal = Cells(i, 1).Value
    Set subFolder = CalFolder.Folders(arrCal)
     If Trim(Cells(i, 11).Value) = "" Then
    Set olappt = subFolder.Items.Add(olAppointmentItem)
          
    'MsgBox subFolder, vbOKCancel, "Folder Name"
 
    With olappt
     
    'Define calendar item properties
        .Start = Cells(i, 6) + Cells(i, 7)     '+ TimeValue("9:00:00")
        .End = Cells(i, 8) + Cells(i, 9)       '+TimeValue("10:00:00")


        
        .Subject = Cells(i, 2)
        .Location = Cells(i, 3)
        .Body = Cells(i, 4)
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = Cells(i, 10)
        .ReminderSet = False
        .Categories = Cells(i, 5)
        .Save
     
    End With
    Cells(i, 11) = "Imported"
    
    End If
    
        i = i + 1
        Loop
    Set olappt = Nothing
    Set olApp = Nothing
     ThisWorkbook.Save
    Exit Sub
     
Err_Execute:
    MsgBox "An error occurred - Exporting items to Calendar."
     
End Sub




And I need to convert that into Late Binding

I have attempted something as shown below, but I get error 438 Object does not support this property of method
here is what I did so far:




Code:
Option Explicit

Sub CreateOutlookApptz()

     
    Dim olApp As Object
    Dim olNs As Object
    Dim olappt As Object
    Dim CalFolder As Object
    Dim subFolder As Object
    
    
    Set olApp = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    Set olappt = olApp.olAppointmentItem
    
    Dim blnCreated As Boolean
    Set CalFolder = olApp.MAPIFolder
    Set subFolder = olApp.MAPIFolder
    Dim arrCal As String
    Dim i As Long
    
    If answer = vbYes Then
      
    Sheets("Sheet1").Select
    
   ' On Error GoTo Err_Execute
    On Error Resume Next
    Set olApp = CreateObject("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
     
    Const olFolderCalendar = 9
    Const olAppointmentItem = 1
    
    Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)
         
    i = 2
    Do Until Trim(Cells(i, 1).Value) = ""
    arrCal = Cells(i, 1).Value
    Set subFolder = CalFolder.Folders(arrCal)
     If Trim(Cells(i, 11).Value) = "" Then


    Set olappt = subFolder.Items.Add(olAppointmentItem)
          
    'MsgBox subFolder, vbOKCancel, "Folder Name"
 
    With olappt
     
    'Define calendar item properties
        .Start = Cells(i, 6) + Cells(i, 7)     '+ TimeValue("9:00:00")
        .End = Cells(i, 8) + Cells(i, 9)       '+TimeValue("10:00:00")


        
        .Subject = Cells(i, 2)
        .Location = Cells(i, 3)
        .Body = Cells(i, 4)
        .BusyStatus = olApp.olBusy
        .ReminderMinutesBeforeStart = Cells(i, 10)
        .ReminderSet = False
        .Categories = Cells(i, 5)
        .Save
     
    End With
    Cells(i, 11) = "Imported"
    
    End If
    
        i = i + 1
        Loop
    Set olappt = Nothing
    Set olApp = Nothing
     ThisWorkbook.Save
    Exit Sub
     
Err_Execute:
    MsgBox "An error occurred - Exporting items to Calendar."
     
     Else
    'do nothing


End If
     
End Sub

Do you see where it goes wrong?
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Can you click Debug in the error dialog box and identify the offending line of code?

Just by looking at it, these lines could be causing it:

Code:
        .BusyStatus = olApp.olBusy
You should replace it with the actual value of olBusy.
 
Upvote 0
If you set the Outlook references on a PC using the oldest version of Outlook you'll be supporting and distribute that version of the code, you can continue to use early binding. Testing on a PC using the oldest version of Outlook you'll be supporting is good practice anyway, just so you can be sure things work the same way on all supported platforms.
 
Upvote 0
Can you click Debug in the error dialog box and identify the offending line of code?

Just by looking at it, these lines could be causing it:

Code:
        .BusyStatus = olApp.olBusy
You should replace it with the actual value of olBusy.


Thank you i changed that line to
Code:
.BusyStatus = 2

and ts at
Code:
    Set CalFolder = olapp.MAPIFolder
    Set subFolder = olapp.MAPIFolder
that the F8 debugs to.

I have tried
Code:
olNs.MAPIFolder  and  olappt .MAPIFolder
neither work but Im not surprised it was a wild guess
 
Last edited:
Upvote 0
Below is what I translated to late-binding from your first code block. (Untested, but it does compile)

Code:
Option Explicit
Sub CreateOutlookApptz()

    Const olFolderCalendar As Long = 9
    Const olAppointmentItem As Long = 1
    Const olBusy As Long = 2
    
    Dim olApp As Object
    Dim olappt As Object
    Dim blnCreated As Boolean
    Dim olNs As Object
    Dim CalFolder As Object
    Dim subFolder As Object
    Dim arrCal As String
    Dim i As Long
        
    Sheets("Sheet1").Select
    
   ' On Error GoTo Err_Execute
    On Error Resume Next
    Set olApp = GetObject(Class:="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) = ""
    arrCal = Cells(i, 1).Value
    Set subFolder = CalFolder.Folders(arrCal)
     If Trim(Cells(i, 11).Value) = "" Then
    Set olappt = subFolder.Items.Add(olAppointmentItem)
          
    'MsgBox subFolder, vbOKCancel, "Folder Name"
 
    With olappt
     
    'Define calendar item properties
        .Start = Cells(i, 6) + Cells(i, 7)     '+ TimeValue("9:00:00")
        .End = Cells(i, 8) + Cells(i, 9)       '+TimeValue("10:00:00")




        
        .Subject = Cells(i, 2)
        .Location = Cells(i, 3)
        .Body = Cells(i, 4)
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = Cells(i, 10)
        .ReminderSet = False
        .Categories = Cells(i, 5)
        .Save
     
    End With
    Cells(i, 11) = "Imported"
    
    End If
    
        i = i + 1
        Loop
    Set olappt = Nothing
    Set olApp = Nothing
     ThisWorkbook.Save
    Exit Sub
     
Err_Execute:
    MsgBox "An error occurred - Exporting items to Calendar."
     
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top