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

R

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

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
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
iliace said:
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.
Click to expand...


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
rouzacct said:
and ts at
Code: 
    Set CalFolder = olapp.MAPIFolder
    Set subFolder = olapp.MAPIFolder
that the F8 debugs to.
Click to expand...

Just remove those two lines completely.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Georgiboy
  • Solved
Intermittent error Excel - Outlook VBA
2
Replies
14
Views
536
Georgiboy
Georgiboy
L
  • Question
VBA query - not opening outlook email but one drive
Replies
0
Views
167
Liverlee
L
N
  • Question
2 QUESTIONS - DATE SEARCH AND OUTLOOK CALENDER
Replies
0
Views
219
nick_rubingh
N
C
  • Question
VBA to Create and Delete Outlook Appointments not working
Replies
2
Views
588
cSciFiChick
C
H
  • Question
Macro to Generate Reminder in Outlook Calendar
Replies
3
Views
1K
Micron
M

Forum statistics

Threads
1,214,516
Messages
6,119,980
Members
448,934
Latest member
audette89

Share this page

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