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
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:
Do you see where it goes wrong?
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?