J
Jesper
Hi
I have pretty much the problem described in this article :
http://support.microsoft.com/default.aspx?scid=kb;en-us;232534 except that my
problem is I using outlook 2003, and the suggestion on make late binding to
appointment item doesn't resolve the problem. What does solve the problem is
give full rights in the item folder to the user running my program, but that
is not the solution in will implement.
My code look like this:
My input is
Startdate : The startdate from which to return appointments
Lookaheaddays : the number of days to return appointments for
calenders : currently a folderid (later maybe an array of folderid's)
Public Function GetAppointments(Startdate, LookAheadDays, Calenders) As
Variant
Dim count
Dim MyItems
Dim Appointments As Collection
Dim AppItem As Object 'Outlook.AppointmentItem
Dim UserID As String
'Dim UserObj As Outlook.Recipient
Dim MyFolder
MaxTime = DateSerial(DatePart("yyyy", Startdate), DatePart("m",
Startdate), DatePart("d", Startdate) + LookAheadDays)
If Left(Calenders, 4) = "USER" Then
UserID = Mid(Calenders, 6)
If UCase(UserID) = "SELF" Then
Set MyFolder = NameSpace.GetDefaultFolder(9)
Else
Set UserObj = NameSpace.CreateRecipient(UserID)
UserObj.Resolve
If UserObj.Resolved Then
Set MyFolder = NameSpace.GetSharedDefaultFolder(UserObj,
olFolderCalendar)
Else
Set MyFolder = Nothing
End If
End If
Else
'Set MyFolder = NameSpace.GetFolderFromID(Calenders)
Set MyFolder = FindFolderById(Calenders)
End If
If Not MyFolder Is Nothing Then
Set Appointments = New Collection
Set MyItems = MyFolder.Items
MyItems.Sort "[Start]", False
MyItems.IncludeRecurrences = True
Set AppItem = MyItems.Find(" ([Start] >= '" & CStr(DateAdd("d", -1,
Startdate)) & "')")
While Not (AppItem Is Nothing)
DoEvents
If (AppItem.Start < MaxTime) Then
If (AppItem.Start >= Startdate) Then
Appointments.Add AppItem
End If
Set AppItem = MyItems.FindNext
Else
Set AppItem = Nothing
End If
Wend
Else
Set Appointments = Nothing
End If
Set AppItem = Nothing
Set MyItems = Nothing
Set MyFolder = Nothing
Set GetAppointments = Appointments
End Function
The Recurring Appointments are included in below statement,
Set AppItem = MyItems.Find(" ([Start] >= '" & CStr(DateAdd("d", -1,
Startdate)) & "')")
even that the stated startdato is before the searched startdate, so the
return of appointmest is actually right, but it contains the data of the
first (master) appointment.
What to do???
Another problem is when executing the following (commented in above code
bacuase of workaround)
Set MyFolder = NameSpace.GetFolderFromID(SomeFolderIdOfSharedFolder)
result sometimes in outlook doesn't return a result og returns an outlook
error.
It is even worse when the folderid is of a folder bellonging to another
person, and if the folder is not part of the folderlist in outlook.
In 2003 when open an another users calender by
NameSpace.GetSharedDefaultFolder(UserObj, olFolderCalendar) the folder is
"mounted" in the 2003 panel, which is not always wanted.
I have pretty much the problem described in this article :
http://support.microsoft.com/default.aspx?scid=kb;en-us;232534 except that my
problem is I using outlook 2003, and the suggestion on make late binding to
appointment item doesn't resolve the problem. What does solve the problem is
give full rights in the item folder to the user running my program, but that
is not the solution in will implement.
My code look like this:
My input is
Startdate : The startdate from which to return appointments
Lookaheaddays : the number of days to return appointments for
calenders : currently a folderid (later maybe an array of folderid's)
Public Function GetAppointments(Startdate, LookAheadDays, Calenders) As
Variant
Dim count
Dim MyItems
Dim Appointments As Collection
Dim AppItem As Object 'Outlook.AppointmentItem
Dim UserID As String
'Dim UserObj As Outlook.Recipient
Dim MyFolder
MaxTime = DateSerial(DatePart("yyyy", Startdate), DatePart("m",
Startdate), DatePart("d", Startdate) + LookAheadDays)
If Left(Calenders, 4) = "USER" Then
UserID = Mid(Calenders, 6)
If UCase(UserID) = "SELF" Then
Set MyFolder = NameSpace.GetDefaultFolder(9)
Else
Set UserObj = NameSpace.CreateRecipient(UserID)
UserObj.Resolve
If UserObj.Resolved Then
Set MyFolder = NameSpace.GetSharedDefaultFolder(UserObj,
olFolderCalendar)
Else
Set MyFolder = Nothing
End If
End If
Else
'Set MyFolder = NameSpace.GetFolderFromID(Calenders)
Set MyFolder = FindFolderById(Calenders)
End If
If Not MyFolder Is Nothing Then
Set Appointments = New Collection
Set MyItems = MyFolder.Items
MyItems.Sort "[Start]", False
MyItems.IncludeRecurrences = True
Set AppItem = MyItems.Find(" ([Start] >= '" & CStr(DateAdd("d", -1,
Startdate)) & "')")
While Not (AppItem Is Nothing)
DoEvents
If (AppItem.Start < MaxTime) Then
If (AppItem.Start >= Startdate) Then
Appointments.Add AppItem
End If
Set AppItem = MyItems.FindNext
Else
Set AppItem = Nothing
End If
Wend
Else
Set Appointments = Nothing
End If
Set AppItem = Nothing
Set MyItems = Nothing
Set MyFolder = Nothing
Set GetAppointments = Appointments
End Function
The Recurring Appointments are included in below statement,
Set AppItem = MyItems.Find(" ([Start] >= '" & CStr(DateAdd("d", -1,
Startdate)) & "')")
even that the stated startdato is before the searched startdate, so the
return of appointmest is actually right, but it contains the data of the
first (master) appointment.
What to do???
Another problem is when executing the following (commented in above code
bacuase of workaround)
Set MyFolder = NameSpace.GetFolderFromID(SomeFolderIdOfSharedFolder)
result sometimes in outlook doesn't return a result og returns an outlook
error.
It is even worse when the folderid is of a folder bellonging to another
person, and if the folder is not part of the folderlist in outlook.
In 2003 when open an another users calender by
NameSpace.GetSharedDefaultFolder(UserObj, olFolderCalendar) the folder is
"mounted" in the 2003 panel, which is not always wanted.