V
vegardhv
Hey
I'm working with automation in the outlook calendar (MS Access using
visual basic).
My goal is to put appointments into a shared calendar - I'm looping
through a database, finding numerous funerals - maybe 3-4 each day,
and want to put them into a shared calendar shared by all the workers
on the funeral parlour.
I've achieved
putting them into the default calendar, but I want it to go into
another one - let's say it's name is "Shared Calendar". I've been
trying lot of things without success - here is my code that puts it
into the default calendar. How do I get it to put the appointments
into a shared calendar ?
I tried to use:
Set ocalItems = oNameSpace.Folder("Shared Calendar").Items
instead of
Set ocalItems = oNameSpace.GetDefaultFolder(olFolderCalendar).Items
Below is my code that works for the default calendar in outlook .
Sorry if I sound n00bish. And btw - you got any tutorials, books I can
read on this topic to get a better understanding I would highly
appreciate it.
Hope any of you bright minds can help
regards
Vegard
------------------------------------------------------------------------------------------------------
Dim oOutlook As New outlook.Application
Dim oNameSpace As NameSpace
Dim Appointment As Object
Dim ocalItems As Items
Dim AppointmentDate As String
Dim rs As Recordset
Dim db As Database
Dim sql As String
Dim today As Date
Dim myRecipient As outlook.Recipient
Dim olApp As outlook.Application
today = Now()
Set oNameSpace = oOutlook.GetNamespace("MAPI")
Set ocalItems = oNameSpace.GetDefaultFolder(olFolderCalendar).Items
AppointmentDate = Now() - 1
Set Appointment = ocalItems.GetFirst
Do While Not (Appointment Is Nothing)
If Appointment.Start > AppointmentDate Then
Appointment.Delete
End If
Set Appointment = ocalItems.GetNext
Loop
Set olApp = CreateObject("Outlook.Application")
Set olAppt = olApp.CreateItem(olAppointmentItem)
' Set start time for 2-minutes from now...
'olAppt.Start = Now() + (2# / 24# / 60#)
olAppt.Start = Format(rs("dato_begravelse") & " " &
rs("klokkeslett_begravelse"), "dd/mm/yyyy hh:mm")
' Setup other appointment information...
With olAppt
.Duration = 60
.Subject = "Begravelse"
.Body = "Begravelse for " & rs("fornavn_avdøde") & " " &
rs("etternavn_avdøde")
.Location = rs("kirkenavn")
.ReminderMinutesBeforeStart = 15
.ReminderSet = True
End With
' Save Appointment...
olAppt.Save
Set olApp = Nothing
Set Appointment = Nothing
Set ocalItems = Nothing
Set oNameSpace = Nothing
Set oOutlook = Nothing
I'm working with automation in the outlook calendar (MS Access using
visual basic).
My goal is to put appointments into a shared calendar - I'm looping
through a database, finding numerous funerals - maybe 3-4 each day,
and want to put them into a shared calendar shared by all the workers
on the funeral parlour.
I've achieved
putting them into the default calendar, but I want it to go into
another one - let's say it's name is "Shared Calendar". I've been
trying lot of things without success - here is my code that puts it
into the default calendar. How do I get it to put the appointments
into a shared calendar ?
I tried to use:
Set ocalItems = oNameSpace.Folder("Shared Calendar").Items
instead of
Set ocalItems = oNameSpace.GetDefaultFolder(olFolderCalendar).Items
Below is my code that works for the default calendar in outlook .
Sorry if I sound n00bish. And btw - you got any tutorials, books I can
read on this topic to get a better understanding I would highly
appreciate it.
Hope any of you bright minds can help
regards
Vegard
------------------------------------------------------------------------------------------------------
Dim oOutlook As New outlook.Application
Dim oNameSpace As NameSpace
Dim Appointment As Object
Dim ocalItems As Items
Dim AppointmentDate As String
Dim rs As Recordset
Dim db As Database
Dim sql As String
Dim today As Date
Dim myRecipient As outlook.Recipient
Dim olApp As outlook.Application
today = Now()
Set oNameSpace = oOutlook.GetNamespace("MAPI")
Set ocalItems = oNameSpace.GetDefaultFolder(olFolderCalendar).Items
AppointmentDate = Now() - 1
Set Appointment = ocalItems.GetFirst
Do While Not (Appointment Is Nothing)
If Appointment.Start > AppointmentDate Then
Appointment.Delete
End If
Set Appointment = ocalItems.GetNext
Loop
Set olApp = CreateObject("Outlook.Application")
Set olAppt = olApp.CreateItem(olAppointmentItem)
' Set start time for 2-minutes from now...
'olAppt.Start = Now() + (2# / 24# / 60#)
olAppt.Start = Format(rs("dato_begravelse") & " " &
rs("klokkeslett_begravelse"), "dd/mm/yyyy hh:mm")
' Setup other appointment information...
With olAppt
.Duration = 60
.Subject = "Begravelse"
.Body = "Begravelse for " & rs("fornavn_avdøde") & " " &
rs("etternavn_avdøde")
.Location = rs("kirkenavn")
.ReminderMinutesBeforeStart = 15
.ReminderSet = True
End With
' Save Appointment...
olAppt.Save
Set olApp = Nothing
Set Appointment = Nothing
Set ocalItems = Nothing
Set oNameSpace = Nothing
Set oOutlook = Nothing