hi folks, I tried to change code to late binding but messed it up at all. I am very beginner, so I ask you. Can somebody help ? I need it because code runs betweeen different stations with different office versions...
can you help ? thanks
'-------------------------------------------------
'original code early binding (inspired from web forums):
'-------------------------------------------------
'-------------------------------------------------
'my not working trial for late binding:
'-------------------------------------------------
can you help ? thanks
'-------------------------------------------------
'original code early binding (inspired from web forums):
'-------------------------------------------------
Code:
Sub CreateAppointment()
' adds a appontments to non deafault folder the Calendar in Outlook
Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim olFldr As Outlook.MAPIfolder 'not needed in only default folder is used
Dim objOwner As Outlook.recipient 'not needed in only default folder is used
Dim oNs As Namespace 'not needed in only default folder is used
Dim oPattern As RecurrencePattern
On Error Resume Next
Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook nie je nainštalovaný"
Exit Sub
End If
End If
' Allow accessing data stored in the user's mail stores in Outlook (not needed for default folder)
Set oNs = Outlook.GetNamespace("MAPI")
' Set share calender owner (not needed for default folder)
Set objOwner = oNs.CreateRecipient("jhajko@...")
objOwner.Resolve
On Error Resume Next
If objOwner.Resolved Then ' (not needed if default folder is used)
' Set up non-default share folder location
Set olFldr = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar).Parent.Folders("Narodeniny")
' Set up non-default folder location
Set olFldr = oNs.GetDefaultFolder(olFolderCalendar).Parent.Folders("Narodeniny")
End If
On Error GoTo errorhandler:
'Set olAppItem = olApp.CreateItem(olAppointmentItem) ' creates a new appointment in default folder
Set olAppItem = olFldr.Items.Add ' creates a new appointment in non default folder
'ročné opakovanie
Set oPattern = olAppItem.GetRecurrencePattern
With oPattern
' Appointment occurs every n-th year (with n indicated by the Interval property)
.RecurrenceType = olRecursYearly
' Appointment becomes effective on...
.DayOfMonth = Format(myStartDate, "d")
.MonthOfYear = Format(myStartDate, "m")
' Appointment starts at ...
.StartTime = myStartTime
' Appointment ends at...
.EndTime = myEndTime
End With
With olAppItem
' set default appointment values
.Location = myLocation
.Body = myBody
.ReminderSet = True
.ReminderMinutesBeforeStart = myReminder
.BusyStatus = myBusyStatus
.RequiredAttendees = myRecipient
On Error Resume Next
.Start = myStartTime & myStartDate
.End = myEndTime & myEndDate
.Subject = mySubject
'.Attachments.Add ("c:\temp\somefile.msg")
.Categories = myCategory ' add this to be able to delete the testappointments
On Error GoTo 0
.Display
.Save 'saves the new appointment
'.Send 'pošle pozvánku
End With
'Release references to the appointment series
Set oPattern = Nothing
Set olAppItem = Nothing
Set olApp = Nothing
End
errorhandler:
MsgBox ("Error: " & Err.Description)
End Sub'-------------------------------------------------
'my not working trial for late binding:
'-------------------------------------------------
Code:
Sub CreateAppointmentLateBinding()
' adds a appontments to non deafault folder the Calendar in Outlook
Const olFolderCalendar As Long = 9
Const olAppointmentItem As Long = 1
Const olBusy As Long = 2
Dim olApp As Object
Dim olAppItem As Object
Dim olFldr As Object
Dim objOwner As Object 'not needed in only default folder is used
Dim oNs As Object 'not needed in only default folder is used
Dim oPattern As Object
Set olApp = CreateObject("Outlook.Application")
Set olAppItem = olApp.AppointmentItem
Set olFldr = olApp.MAPIfolder 'not needed in only default folder is used
Set objOwner = olApp.recipient
Set oNs = olApp.Namespace 'not needed in only default folder is used
Set oPattern = olApp.RecurrencePattern
On Error Resume Next
Set olApp = GetObject(Class:="Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook nie je nainštalovaný"
Exit Sub
End If
End If
' Allow accessing data stored in the user's mail stores in Outlook (not needed for default folder)
Set oNs = olApp.GetNamespace("MAPI")
' Set share calender owner (not needed for default folder)
Set objOwner = oNs.CreateRecipient("jhajko...")
objOwner.Resolve
On Error Resume Next
If objOwner.Resolved Then ' (not needed if default folder is used)
' Set up non-default share folder location
Set olFldr = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar).Parent.Folders("Narodeniny")
' Set up non-default folder location
Set olFldr = oNs.GetDefaultFolder(olFolderCalendar).Parent.Folders("Narodeniny")
End If
On Error GoTo errorhandler:
'Set olAppItem = olApp.CreateItem(olAppointmentItem) ' creates a new appointment in default folder
Set olAppItem = olFldr.Items.Add(allAppItem) ' creates a new appointment in non default folder
'ročné opakovanie
Set oPattern = olAppItem.GetRecurrencePattern
With oPattern
' Appointment occurs every n-th year (with n indicated by the Interval property)
.RecurrenceType = olRecursYearly
' Appointment becomes effective on...
.DayOfMonth = Format(myStartDate, "d")
.MonthOfYear = Format(myStartDate, "m")
' Appointment starts at ...
.StartTime = myStartTime
' Appointment ends at...
.EndTime = myEndTime
End With
With olAppItem
' set default appointment values
.Location = myLocation
.Body = myBody
.ReminderSet = True
.ReminderMinutesBeforeStart = myReminder
.BusyStatus = myBusyStatus
.RequiredAttendees = myRecipient
On Error Resume Next
.Start = myStartTime & myStartDate
.End = myEndTime & myEndDate
.Subject = mySubject
'.Attachments.Add ("c:\temp\somefile.msg")
.Categories = myCategory ' add this to be able to delete the testappointments
On Error GoTo 0
.Display
.Save 'saves the new appointment
'.Send 'pošle pozvánku
End With
'Release references to the appointment series
Set oPattern = Nothing
Set olAppItem = Nothing
Set olApp = Nothing
End
errorhandler:
MsgBox ("Error: " & Err.Description)
End Sub
