Listing

Lotus Notes Calendaring with VB / VBA.

Part 2 - How to Retrieve a List of Appointments From a Lotus Notes Calendar Using COM

Page: << 1 2 3 >>

Now we get into the thick of it. Retrieving the list of Appointments. My holy grail of scheduling. First off you may notice that this is not the most elegant piece of code. I have to make the assumption that the first appointment of the day begins either on the hour or half hour which really bugs me. But the only other option I could think of was to do a FTSearch (full text) on the entire database which took about 3 seconds per call. That was just unacceptable since the routine may need to be called in excess of 10 times in a row. This method is quick, it only takes a second to grab 5 people's appointments for a day. If you can find a way around this without making the intervals shorter, PLEASE send me the code, I will be eternally grateful. Other than that it is a pretty slick little maneuver.

If you have read part one, you should already be familiar with most of the arguments and how they work. There is one exception though. That is OutLen. OutLen is a for-output argument that specifies the length of the return array for easy processing.

Since the initialization works virtually the same way as the as in part 1, I will assume you already understand what's going on and move on to the new stuff.

Here we have the less than elegant part of the code that I mentioned above. It starts at 8am on the specified date and checks for documents that begin at 8:00, then 8:30, then 9:00 etc... until it grabs an appointment. You may be wondering why you can't use GetDocumentByKey(#4/14/2005#) and have it return the first appointment for the day. I wish I knew why you can't, but you just can't. When it finds the appointment, we move on to the more solid part of the code.
Set vw = db.GETVIEW("Calendar")
Set doc = vw.GETDOCUMENTBYKEY(ThisDate)
Do Until Not doc Is Nothing
ThisDate = DateAdd("n", intIncrement, ThisDate)
int8to5 = int8to5 - 1
If int8to5 = 0 Then GoTo DoReturnFalse
Set doc = vw.GETDOCUMENTBYKEY(ThisDate)
strLastSDT = ThisDate
Loop

The first half of it is pretty self explanatory. The array is structured like so:

ArrOut(i, 1): Start Date & Time
ArrOut(i, 2): Duration
ArrOut(i, 3): Form Type (appointment, meeting, etc)
ArrOut(i, 4): Subject

Ok, we're at the complicated part. I had a bunch of difficulty with the routine not recognizing repeating events and everything would explode when the first appointment of the following day was repeating. Here's how I took care of that. First strRepeats is set to 1 if it is a repeating appointment. The problem lies in the fact that the StartDateTime pulled from a repeating appointment has the date of the first occurance and not the current date. If the routine notices that the start date of the event is different from the date we are looking for, it checks to see if it is repeating via strRepeats. If it is repeating, it changes the date to the date we want and checks to see if it occurs AFTER the value of strLastSDT (so if the last appointment was 4:00pm, and the one we are looking at is 8:00am, it must mean that the first appointment tomorrow is recurring.) If the appointment is not recurring, it simply checks to see if the date is the same as the date we want. If so, it gets the next document and if not, we have already processed all the appointments we want to. Please note that the first appoint for the next day will appear in the output array, but the array length output will not allow it to be displayed if used properly.

i = 1
Do Until doc Is Nothing

strSDT = doc.GETITEMVALUE("STARTDATETIME")(0)
ArrOut(i, 1) = strSDT
strEDT = doc.GETITEMVALUE("ENDDATETIME")(0)
ArrOut(i, 2) = DateDiff("n", CDate(strSDT), CDate(strEDT))
strFType = doc.GETITEMVALUE("FORM")(0)
ArrOut(i, 3) = strFType
strSubj = doc.GETITEMVALUE("SUBJECT")(0)
ArrOut(i, 4) = strSubj
strRepeats = CStr(doc.GETITEMVALUE("REPEATS")(0))

If (DateDiff("d", CDate(strSDT), ThisDate) <> 0) Then
If (strRepeats = "1") Then
strSDT = StartDate & " " & FormatDateTime(strSDT, vbLongTime)
strLastSDT = StartDate & " " & FormatDateTime(strLastSDT, vbLongTime)
If DateDiff("n", CDate(strLastSDT), CDate(strSDT)) >= -60 Then
ArrOut(i, 1) = strSDT
GoTo GoNext
End If
End If
Set doc = Nothing
Else
GoNext:
strLastSDT = strSDT
Set doc = vw.GETNEXTDOCUMENT(doc)
i = i + 1
End If
Loop

Finally, check to see if any appointments were found (i > 1), return the array and length and we are all done.
If i > 1 Then
GetUsedTime = ArrOut
OutLen = i - 1
Exit Function
End If

DoReturnFalse:
GetUsedTime = False
OutLen = 0

Here's the full code.

GetUsedTime

Public Function GetUsedTime(ByVal UserName As String, ByVal UserPass As String, ByVal StartDate As String, Optional ByRef OutLen As Integer) As Variant
Dim db As Object, ns As Object, vw As Object, doc As Object, MailDbName As String
Dim strSDT As String, strEDT As String, strFType As String, strSubj As String
Dim ToEnd As Integer, intIncrement As Integer, int8to5 As Integer, i As Integer
Dim ThisDate As Date, strRepeats As String, strLastSDT As String, strServer as String

Dim ArrOut(1 To 30, 1 To 4)

strServer = "YourServerName"

On Error GoTo DoReturnFalse

intIncrement = 30
int8to5 = 17 '8am to 5 pm = 540 mins - 30 mins (4:30, last appt) = 510 mins / 30 min intervals = 17 intervals

ThisDate = CDate(StartDate & " 8:00 AM")

MailDbName = "mail\" + UserName + ".nsf"
Set ns = CreateObject("lotus.NotesSession")
If Not UserPass = "~" Then
Call ns.Initialize(UserPass)
Else
Call ns.Initialize
End If

Set db = ns.GETDATABASE(strServer, MailDbName, False)

If Not db.ISOPEN Then Exit Function
Set vw = db.GETVIEW("Calendar")
Set doc = vw.GETDOCUMENTBYKEY(ThisDate)
Do Until Not doc Is Nothing
ThisDate = DateAdd("n", intIncrement, ThisDate)
int8to5 = int8to5 - 1
If int8to5 = 0 Then GoTo DoReturnFalse
Set doc = vw.GETDOCUMENTBYKEY(ThisDate)
strLastSDT = ThisDate
Loop
i = 1
Do Until doc Is Nothing

Page: 1 2 3 Part 3: Examples and more>>