Copy this and save as HTML. Open outside of Outlook and read directions.
This is the greatest thing to come to Group Calendars.
<!--
Outlook Team Calendar Application V 2.2
(c) 1999-2001
-->
<HTML>
<HEAD>
<TITLE>Outlook Team Calendar</TITLE>
<META HTTP-EQUIV="Expires" CONTENT="0">
<script language="VBScript">
' Welcome to a code review of Outlook Team Calendar and thanks for taking
the time to see how all this is done.
' Hopefully you will learn something new about all this objects and
technologies involved in this solution.
' You will find reusable functions and code-snippets which you may want to
use in other Outlook / IE - based
' solutions, so go ahead sniffing ;-)
Option Explicit
Const olAppointmentItem = 1
Const olFolderCalendar = 9
Const olPrivate = 2
Const cgstrMsgBoxTitle = "Team Calendar Message"
Const cgstrDefaultDescription = "What is my Team doing today"
Const cgReg_AskForRefresh = "AskForRefresh"
Const cgReg_IncludeRecurences = "IncludeRecurrences"
Const cgReg_TeamDescription = "TeamDescription"
Const cgReg_MemberList = "MemberList"
Const cgReg_LastRefresh = "LastRefresh"
Const cgReg_NumberOfDays = "NumberOfDays"
Const cgReg_Filter = "Filter"
Const cgReg_BeginOfWorkDay = "BeginOfWorkDay"
Const cgReg_EndOfWorkDay = "EndOfWorkDay"
Const cgReg_IntervalInMinutes = "IntervalInMinutes"
Const cgReg_ShowOverview = "ShowOverview"
' localized outlook properties
Dim gbDateLocaleChecked 'As Boolean
Dim gstrLocalized_ReferenceDateFormat 'As String
Dim gstrLocalized_TeamCalendarViewName 'As String
Dim gstrLocalized_StartOutlookFieldName 'As String
Dim gApp, gThisFolder, gNamespace 'As Outlook Object(s)
Dim gstrStartTime, gstrEndTime 'As String
Dim garrTeamMembers 'As String(s)
Dim gstrMemberList 'As String
Dim garrTeamMemberStatus 'As String(s)
Dim gstrSettingsPrefix 'As String
Dim gNumberOfDays 'As String
Dim gstrFilter 'As String
Dim gstrTeamCalendarPath 'As String
Dim gbAskForRefresh 'As Boolean
Dim gbCancelGetRecipientsAppointments 'As Boolean
Dim gbIncludeRecurrences 'As Boolean
Dim gBeginOfWorkDay ' As Integer (hour)
Dim gEndOfWorkDay ' As Integer (hour)
Dim gIntervalInMinutes ' As Integer (minutes)
Dim gbShowOverview ' As Boolean
Dim gbRunningInOutlook 'As Boolean
Dim gbOffline 'As Boolean
Dim gbRefreshErrors 'As Boolean
Dim gbRedrawTeamCalendar 'As Boolean
' check if we're running already as a folder homepage
Err.Clear()
On Error Resume Next
Set gApp = window.external.OutlookApplication
gbRunningInOutlook = (Err.number = 0)
On Error Goto 0
If gbRunningInOutlook Then
Dim strUserStoreName 'As String
Dim strCurrentUserName 'As String
Set gThisFolder = gApp.ActiveExplorer.CurrentFolder
Set gNamespace = gApp.GetNamespace("MAPI")
gstrTeamCalendarPath = FolderPath(gThisFolder)
strUserStoreName =
gNamespace.GetDefaultFolder(olFolderCalendar).Parent
strCurrentUserName = Trim(Mid(strUserStoreName,
InStr(strUserStoreName, "-") + 1))
gbOffline = IsOffline()
'MakeOffline gThisFolder
gstrSettingsPrefix = "DD_TeamCal_" & gThisFolder.Name & "_for_" &
strCurrentUserName & "_"
Call GenerateTeamMembersArray()
' code continues in the page onload event...
End If
Function FolderPath(ByVal oFolder) 'As String
Dim strFolderPath 'As String
Err.Clear()
On Error Resume Next
Do While Err.number = 0
strFolderPath = oFolder.Name & "\" & strFolderPath
Set oFolder = oFolder.Parent
Loop
FolderPath = "\\" & Left(strFolderPath, Len(strFolderPath) - 1)
End Function
Function IsOffline() 'As Boolean
Const CdoPR_STORE_OFFLINE = &H6632000B
Dim CDOSession 'As Object
Dim objInfoStore 'As Object
IsOffline = True
'Use CDO to check online/offline mode (Q181035)
Set CDOSession = GetCDO()
If Not CDOSession Is Nothing Then
' PR_STORE_OFFLINE is set on the Message Store object
' try to test this flag on the Mailbox/OST store itself
Set objInfoStore = CDOSession.GetInfoStore() ' return
default info store
On Error Resume Next
IsOffline = objInfoStore.Fields(CdoPR_STORE_OFFLINE).Value
' property is only available on Mailbox/OST store, but not on PST stores
If Err.Number <> 0 Then IsOffline = False ' running
off a PST store, so we have to run online in PST mode
CDOSession.Logoff
Set CDOSession = Nothing
End If
End Function
Sub MakeOffline(ByVal gThisFolder)
Const CdoPR_MAKE_OFFLINE = &H663D0003
Dim CDOSession 'As Object
Dim CDOFolder 'As Object
Dim StoreID 'As String
Dim EntryID 'As String
' use CDO to mark the folder for offline usage
Set CDOSession = GetCDO()
If Not CDOSession Is Nothing Then
' map Outlook folder to CDO folder
StoreID = gThisFolder.StoreID
EntryID = gThisFolder.EntryID
Set CDOFolder = CDOSession.GetFolder(EntryID, StoreID)
' check if this Teamcalendar is running in an Exchange store
' if it's in a PST then there is no need to mark the folder
for offline usage
' make folder available offline
Err.Clear()
On Error Resume Next
CDOFolder.Fields(CdoPR_MAKE_OFFLINE) = 1
CDOFolder.Update
If Err.number <> 0 Then ' access denied error on a PST
MsgBox "This Teamcalendar can't be made available
for offline usage" & _
vbCrLf & vbCrLf & "The error reads as """ &
Err.description & """", _
vbExclamation, cgstrMsgBoxTitle
End If
CDOSession.Logoff
Set CDOSession = Nothing
End If
End Sub
Sub GenerateTeamMembersArray()
Dim i 'As Integer
Dim cMembers 'As Integer
gstrMemberList = Trim(GetPref(cgReg_MemberList))
garrTeamMembers = Split(gstrMemberList, ";")
cMembers = CInt(UBound(garrTeamMembers))
Redim garrTeamMemberStatus(cMembers + 1) ' all members errors
+ teamcal errors
For i = 0 to cMembers
garrTeamMembers(i) = Split(Trim(garrTeamMembers(i)), ":")
Next
End Sub
Sub RenderTeamInvite()
Dim i 'As Integer
Dim strAllMembersEmail 'As String
For i = 0 To CInt(UBound(garrTeamMembers))
strAllMembersEmail = strAllMembersEmail &
garrTeamMembers(i)(1) & ";"
Next
TeamLogo.style.cursor = "hand"
TeamLogo.title = "send meeting request to this team"
TeamLogo.innerHTML = "<span onclick=""javascript:MakeAppt('" &
strAllMembersEmail & "');"" onmouseover=""javascript:LabelHot(this, true);""
onmouseout=""javascript:LabelHot(this, false)"">" & "”" & "</span>"
End Sub
Function GetPref(ByVal ValueName) 'As String
GetPref = Trim(window.external.GetPref(gstrSettingsPrefix &
ValueName))
End Function
Sub SetPref(ByVal ValueName, ByVal Value)
If Value = vbNullString Then Value = " " ' avoid saving empty
string as this results wired when reading with GetPref()
window.external.SetPref gstrSettingsPrefix & ValueName, CStr(Value)
End Sub
Function FormatDateValue(ByVal DateValue) 'As String
Dim strDateUserLocaleFormatted 'As String
If Not gbDateLocaleChecked Then
Dim strTestDate 'As String
Dim appt 'As Appointment
' FormatDateTime() always uses the SYSTEM locale date
settings from VB Script (returns user locale date settings from VBA)
strTestDate = FormatDateTime(#12-31-1999#, vbShortDate) '
need a testdate with makes difference between day/month clear!
' Outlooks Find() and Restrict() methods of a folder work
with the USER locale date settings and only will get results if
' the user locale is the same (not mixed) as the system
locale
Err.Clear()
On Error Resume Next
Set appt =
gNamespace.GetDefaultFolder(olFolderCalendar).Items.Find("[" &
gstrLocalized_StartOutlookFieldName & "] = """ & strTestDate & """")
If Err.number <> 0 Then ' we are in mixed mode
' we need a reference date format, reflecting the
user locale specification of the date format
' (otherwise we'll get type mismatch errors or -
even worse - no results without any errors)
If Left(strTestDate, 2) = "12" Then ' system
locale is US
gstrLocalized_ReferenceDateFormat =
"dd.mm.yy" ' need a NON-US user locale reference date
Else ' system locale is NON-US
gstrLocalized_ReferenceDateFormat =
"mm/dd/yy" ' need a US user locale reference date
End If
End If
On Error Goto 0
gbDateLocaleChecked = True
End If
If gstrLocalized_ReferenceDateFormat <> vbNullString Then
strDateUserLocaleFormatted =
Replace(gstrLocalized_ReferenceDateFormat, "dd", Right("00" & DatePart("d",
DateValue), 2))
strDateUserLocaleFormatted =
Replace(strDateUserLocaleFormatted, "mm", Right("00" & DatePart("m",
DateValue), 2))
FormatDateValue = Replace(strDateUserLocaleFormatted, "yy",
Right(DatePart("yyyy", DateValue), 2)) ' short year
Else
FormatDateValue = FormatDateTime(DateValue, vbShortDate)
' uses system locale date settings
End If
End Function
Sub DoLocalization()
Const cLocalizedFilterPrefix = "Filter_"
Dim strAddFilters 'As String
Dim strFilter 'As String
Dim strFilterDetails 'As StringArray
Dim strFilterExpression 'As String
Dim oOptionFilter 'As OptionElement
' read localizing information - if present, otherwise default to US
settings
gstrLocalized_TeamCalendarViewName = GetLocalized("ViewName",
"Day/Week/Month View With AutoPreview")
gstrLocalized_StartOutlookFieldName = GetLocalized("StartFieldName",
"Start")
If gstrLocalized_StartOutlookFieldName = "Start" Then
' default build-in Outlook US filters
Set oOptionFilter = document.createElement("OPTION")
oOptionFilter.text = "Tentative or Free Appointments"
oOptionFilter.value = "[Show Time As] = 'Tentative' OR [Show
Time As] = 'Free'"
cboFilter.add oOptionFilter
Set oOptionFilter = document.createElement("OPTION")
oOptionFilter.text = "OOF or Busy Appointments"
oOptionFilter.value = "[Show Time As] = 'Out of Office' OR
[Show Time As] = 'Busy'"
cboFilter.add oOptionFilter
Set oOptionFilter = document.createElement("OPTION")
oOptionFilter.text = "Appt where Categories contains
Holiday"
oOptionFilter.value = "[Categories] = 'Holiday'"
cboFilter.add oOptionFilter
End If
strAddFilters = GetLocalized("AddFilters", vbNullString)
If strAddFilters <> vbNullString Then
' load localized filters
For Each strFilter In Split(strAddFilters, ";")
strFilterDetails = Split(strFilter, ":")
strFilterExpression =
GetLocalized(cLocalizedFilterPrefix & Trim(strFilterDetails(0)),
vbNullString)
If strFilterExpression <> vbNullString Then
Set oOptionFilter =
document.createElement("OPTION")
oOptionFilter.text =
Trim(strFilterDetails(1))
oOptionFilter.value = strFilterExpression
cboFilter.add oOptionFilter
End If
Next
End If
End Sub
Function GetLocalized(ByVal ValueName, ByVal strDefaultValue) 'As String
Const cLocalized_Prefix = "DD_TeamCal_Localized_"
Dim strValue 'As String
strValue = Trim(Window.external.GetPref(cLocalized_Prefix &
ValueName))
If strValue = vbNullString Then strValue = strDefaultValue
GetLocalized = strValue
End Function
Function GetCDO() 'As MAPISession
Const cCDOURL =
"http://www.microsoft.com/exchange/downloads/CDO.htm";
Dim bError 'As Boolean
Dim bConfirmInstall 'As Boolean
Dim answer 'As Integer
Dim CDOSession 'As Object
Err.Clear()
On Error Resume Next
Set CDOSession = gApp.CreateObject("MAPI.Session")
CDOSession.Logon vbNullString, vbNullString, False, False, 0
bError = (Err.number <> 0)
On Error Goto 0
If bError Then
answer = MsgBox("No CDO (Collaboration Data Objects) support
found on this machine, please install CDO before using Outlook Team
Calendar." & vbCrLf & _
"You can install CDO as part of an Outlook Custom
Installation (recommended) or download it directly from the Microsoft
Website at" & vbCrLf & vbCrLf & _
cCDOURL & vbCrLf & vbCrLf & _
"Do you want to download CDO from the above WebSite
now?", vbQuestion + vbYesNo + vbDefaultButton2, _
"CDO Installation Confirmation")
bConfirmInstall = (answer = vbYes)
If bConfirmInstall Then
document.location = cCDOURL
End If
gbRunningInOutlook = False ' this shows the Help
Set GetCDO = Nothing
Else
Set GetCDO = CDOSession
End If
End Function
Function IsUserFree(ByVal strAlias, ByVal IntervalInMinutes) 'As Boolean
Const olFree = 0
Const olTentative = 1
Const olBusy = 2
Const olOutOfOffice = 3
Dim oRecipient ' As Recipient
Dim today ' As Date
Dim bSuccess 'As Boolean
Dim strFreeBusy ' As String
Dim theTime ' As Time
Dim MinutesThisDay ' As Integer
Dim FBIndex ' As Integer
IsUserFree = False
Set oRecipient = GetKnownRecipient(strAlias)
If Not oRecipient Is Nothing Then
today = Date
Err.Clear()
On Error Resume Next
strFreeBusy = oRecipient.FreeBusy(today, IntervalInMinutes,
True)
bSuccess = (Err.number = 0)
On Error Goto 0
Set oRecipient = Nothing
If bSuccess Then
theTime = Time
MinutesThisDay = (Hour(theTime) * 60) +
Minute(theTime)
FBIndex = (MinutesThisDay + IntervalInMinutes) \
IntervalInMinutes
IsUserFree = (CInt(Mid(strFreeBusy, FBIndex, 1)) <
olBusy)
End If
End If
End Function
Function GetKnownRecipient(ByVal strAlias) 'As Recipient
Const cHomeDomain = "" '"MCSAustria.com"
Dim d ' As Integer
Dim oRecipient ' As Recipient
Set GetKnownRecipient = Nothing
' check home domain
d = InStr(strAlias, "@")
If d > 0 Then
If InStr(d + 1, strAlias, cHomeDomain, vbTextCompare) <> d +
1 Then
' user is from foreign domain
Exit Function
End If
Else
If LCase(Left(strAlias, 3)) <> "/o=" Then ' not an
X400 address
' append home domain
strAlias = strAlias & "@" & cHomeDomain
End If
End If
Set oRecipient = gNamespace.CreateRecipient(strAlias)
If oRecipient.Resolve() Then ' lookup user in GAL/AD
Set GetKnownRecipient = oRecipient
End If
Set oRecipient = Nothing
End Function
Sub MakeAppt(ByVal strAlias)
Dim appt 'As Appointment
Dim aAliases
Set appt = gApp.CreateItem(olAppointmentItem)
' strip trailing semicolons
While Right(strAlias, 1) = ";"
strAlias = Left(strAlias, Len(strAlias) - 1)
Wend
aAliases = Split(strAlias, ";")
For i = 0 To CInt(UBound(aAliases))
' exclude meeting organizer from team invite list
If gNamespace.CurrentUser.Address <> aAliases(i) Then
appt.Recipients.Add(aAliases(i))
End If
Next
appt.Recipients.ResolveAll()
appt.Display
End Sub
Sub DoRefreshTeamCalendar()
If btnRefresh.className = "btnFormDisabled" Then Exit Sub
lastRefresh.innerHTML = "<font color=black>Refreshing Team Calendar
appointments...</font>"
Call ButtonHot(btnRefresh, False)
Call ButtonHot(btnSave, False)
Call window.setTimeout("RefreshTeamCalendar(False)", 100)
End Sub
Sub RefreshTeamCalendar(ByVal bAsk)
Dim bRefresh 'As Boolean
Dim strLastRefresh 'As String
If bAsk Then
If gbAskForRefresh Then bRefresh = ConfirmRefresh()
Else
bRefresh = True
End If
If bRefresh Then
btnRefresh.className = "btnFormDisabled"
btnSave.className = "btnFormDisabled"
gbRefreshErrors = False
Call GetTeamMembersAppointments()
strLastRefresh = gstrStartTime & " - " & gstrEndTime & ",
last refresh was at " & FormatDateValue(Date()) & " " &
FormatDateTime(Time(), vbShortTime)
If gbRefreshErrors Then
strLastRefresh = strLastRefresh & " <font
color=red>(with refresh errors)</font>"
End If
lastRefresh.innerHTML = strLastRefresh
SetPref cgReg_LastRefresh, strLastRefresh
Call DisplayFilter
Call ShowCal(cal_team)
btnRefresh.className = "btnForm"
btnSave.className = "btnForm"
If gbRedrawTeamCalendar Then
document.execCommand("Refresh")
End If
End If
End Sub
Function ConfirmRefresh() 'As Boolean
Dim answer
answer = Msgbox("Do you want to refresh this Team Calendar?",
vbQuestion + vbYesNo, "Team Calendar Refresh Confirmation")
ConfirmRefresh = (answer = vbYes)
End Function
Sub GetTeamMembersAppointments()
Dim i 'As Integer
Dim today 'As String
Dim wday 'As Integer
Dim firstDayOfMonth 'As Date
Dim cMembers 'As Integer
Dim strRecipName 'As String
Dim strRecipAddress 'As String
Dim AppItem 'As AppointmentItem
Dim strError 'As String
Dim strAppointmentFilter 'As String
today = Date
Select Case gNumberOfDays
Case "m" ' this month
firstDayOfMonth = today - Day(today) + 1
gstrStartTime = FormatDateValue(firstDayOfMonth)
gstrEndTime = FormatDateValue(DateAdd("m", 1,
firstDayOfMonth) - 1)
Case "m+" ' this month and next month
firstDayOfMonth = today - Day(today) + 1
gstrStartTime = FormatDateValue(firstDayOfMonth)
gstrEndTime = FormatDateValue(DateAdd("m", 2,
firstDayOfMonth) - 1)
Case "w" ' this work week (5 days)
wday = WeekDay (today, vbMonday)
gstrStartTime = FormatDateValue(today - wday + 1)
gstrEndTime = FormatDateValue(today - wday + 5)
Case "w+" ' this week and next week (2 full weeks)
wday = WeekDay (today, vbMonday)
gstrStartTime = FormatDateValue(today - wday + 1)
gstrEndTime = FormatDateValue(today - wday + 14)
Case "-w" ' last week and this week (2 full weeks)
wday = WeekDay (today, vbMonday)
gstrStartTime = FormatDateValue(today - wday + 1 -
7)
gstrEndTime = FormatDateValue(today - wday + 7)
Case "-w+" ' this week and the 2 surounding weeks (3
full weeks)
wday = WeekDay (today, vbMonday)
gstrStartTime = FormatDateValue(today - wday + 1 -
7)
gstrEndTime = FormatDateValue(today - wday + 14)
Case Else
gstrStartTime = FormatDateValue(today)
gstrEndTime = FormatDateValue(today +
CInt(gNumberOfDays))
End Select
' append start/end times to start/end dates
gstrStartTime = gstrStartTime & " 00:00"
gstrEndTime = gstrEndTime & " 23:59"
' delete all existing appointments in the team calendar
For i = gThisFolder.Items.Count To 1 Step -1
Set AppItem = gThisFolder.Items(i)
AppItem.Delete
Next
' delete all status messages and clear alert colors
cMembers = CInt(UBound(garrTeamMembers))
cal_team.style.Color = "slategray"
garrTeamMemberStatus(cMembers + 1) = vbNullString
' build the time filter for the calendar collection
strAppointmentFilter = "[" & gstrLocalized_StartOutlookFieldName &
"] >= """ & gstrStartTime & """ AND [" & gstrLocalized_StartOutlookFieldName
& "] <= """ & gstrEndTime & """"
' add the property filter from the filter dropdown combobox
If gstrFilter <> vbNullString Then
strAppointmentFilter = strAppointmentFilter & " AND (" &
gstrFilter & ")"
End If
' read team appts from all members
gbCancelGetRecipientsAppointments = False
For i = 0 To cMembers ' check DIVs as during adding a member the
new div doesn't yet exsist
strRecipName = Trim(garrTeamMembers(i)(0))
strRecipAddress = Trim(garrTeamMembers(i)(1))
If VarType(document.all("cal_member_" & i)) = vbString Then
document.all("cal_member_" & i).style.Color =
"slategray"
garrTeamMemberStatus(i) = vbNullString
End If
If strRecipName <> vbNullString And Not
gbCancelGetRecipientsAppointments Then
GetRecipientsAppointments strRecipName,
strRecipAddress, strAppointmentFilter
End If
Next
If gThisFolder.Items.Count = 0 Then
strError = _
"No Appointments found with the current filter:" &
vbCrLf & vbCrLf & strAppointmentFilter
If gstrFilter <> vbNullString And gbIncludeRecurrences Then
strError = strError & vbCrLf & vbCrLf & "Remember
that some custom filters (as e.g. the Holiday filter) only work WITHOUT
recurrences," & vbCrLf & _
"so you may try this filter again but
UNCHECK the ""include recurring appointments"" checkbox in your personal
preferences." & vbCrLf & vbCrLf & _
"See the Online Help to learn more about
this issues."
End If
MarkRecipientError "cal_team", strError
Msgbox strError, vbExclamation, cgstrMsgBoxTitle
End If
End Sub
Sub GetRecipientsAppointments(ByVal strRecipName, ByVal strRecipAddress,
ByVal strAppointmentFilter)
Const CdoE_FAILONEPROVIDER = &H8004011D
Dim Appointments 'As Items
Dim TeamAppointment 'As AppointmentItem
Dim AppItem 'As AppointmentItem
Dim oRecipient 'As Recipient
Dim strError 'As String
Set Appointments = Nothing
Set oRecipient = GetKnownRecipient(strRecipAddress)
If oRecipient Is Nothing Then
strError = _
"Sorry, the name " & strRecipName & " can't be
resolved from the address book!" & _
vbCrLf & vbCrLf & "Either this recipient was not
found in the address book or it resolves to more ambiguous names."
MarkRecipientError strRecipName, strError
Msgbox strError, vbCritical, cgstrMsgBoxTitle
Exit Sub
End If
strRecipName = oRecipient.Name
' try to read the recipients calendar items collection and check for
all access errors
Err.Clear()
On Error Resume Next
Set Appointments = gNamespace.GetSharedDefaultFolder(oRecipient,
olFolderCalendar).Items
If Err.number <> 0 Then
If Err.number = CdoE_FAILONEPROVIDER Then 'no sufficient
permission
strError = _
"Sorry, it seems that you don't have at
least reviewer (read) access to the calendar of " & strRecipName & "." & _
vbCrLf & vbCrLf & "The error reads as """ &
Err.description & """"
Else
strError = _
"Sorry, you can't access the calendar of " &
strRecipName & "." & _
vbCrLf & vbCrLf & "The error reads as """ &
Err.description & """"
End If
MarkRecipientError strRecipName, strError
Msgbox strError, vbCritical, cgstrMsgBoxTitle
Exit Sub
End If
If Appointments Is Nothing Then
strError = _
"Sorry, you can't access any appointments on the
calendar of " & strRecipName & "." & _
vbCrLf & vbCrLf & "This is only a guess, but maybe
this user still has a Schedule+ calendar."
MarkRecipientError strRecipName, strError
Msgbox strError, vbCritical, cgstrMsgBoxTitle
Exit Sub
End If
With Appointments
' IncludeRecurrences=True REQUIRES the appointments to be
sorted by "START" Ascending
.Sort "[START]" ' seams to be always named START regardless
of the language of Outlook (works in german too)
.IncludeRecurrences = gbIncludeRecurrences
Err.Clear()
Set AppItem = .Find(strAppointmentFilter)
If Err.number <> 0 Then
strError = _
"Sorry, there's a syntax error in your
filter:" & vbCrLf & vbCrLf & strAppointmentFilter & _
vbCrLf & vbCrLf & "If you used a standard
filter and have this error then you may have mixed locale settings, see the
Online Help to learn more about this issue." & _
vbCrLf & vbCrLf & "The error reads as """ &
Err.description & """"
MarkRecipientError "cal_team", strError
Msgbox strError, vbCritical, cgstrMsgBoxTitle
gbCancelGetRecipientsAppointments = True
Exit Sub
End If
strError = vbNullString
Err.Clear()
While Not AppItem Is Nothing
' Set TeamAppointment = AppItem.Copy only would work
on non-recurring items and would also require
' write access in the team members calendar, so we
copy over only the most important fields
Set TeamAppointment =
gApp.CreateItem(olAppointmentItem)
With TeamAppointment
' check for outlook bug Q187482 - still
present in OL2000
' Only certain properties are "safe" to get
in the late-binding scenario.
' These are: messageclass, subject, start,
duration, end, location, sensitivity.
' Accessing other props (e.g. Body) will
cause the appointment to return the
' masterinstance and from that point on the
start and end times will return the
' start and end time of the master
appointment, not the particular instance.
' read start & end time before accessing any
unsafe fields
TeamAppointment.Subject = "[" & strRecipName
& "]: " & AppItem.Subject
.Start = AppItem.Start
.End = AppItem.End
.Duration = AppItem.Duration
.Location = AppItem.Location
.Sensitivity = AppItem.Sensitivity
' unsafe fields (can invalidate the start
and end time to return the masterinstance start/end times
' instead of start/end times of the
particular instance which matches the filter
.AllDayEvent = AppItem.AllDayEvent
.Importance = AppItem.Importance
.Categories = AppItem.Categories
.BusyStatus = AppItem.BusyStatus
.Body = AppItem.Body
.Companies = AppItem.Companies
.IsOnlineMeeting = AppItem.IsOnlineMeeting
If AppItem.IsRecurring Then ' this field
access invalidates the start and end time, that's why we alread got them
before
TeamAppointment.Subject =
TeamAppointment.Subject & " - [recurring]"
End If
' mark the appointments to be easily grouped
by recipient
.OptionalAttendees = strRecipName
If Err.number = 0 Then
.Move gThisFolder
Else
strError = strError & vbCrLf &
vbCrLf & _
"Error occurred accessing an
appointment:" & vbCrLf & Err.description
Err.Clear()
End If
End With
Set AppItem = .FindNext
Wend
If strError <> vbNullString Then
MarkRecipientError strRecipName, strError
End If
End With
End Sub
Sub MarkRecipientError(ByVal strRecipName, ByVal strMessage)
Dim i 'As Integer
Dim cMembers 'As Integer
gbRefreshErrors = True
cMembers = CInt(UBound(garrTeamMembers))
' append error message
If LCase(strRecipName) = "cal_team" Then
cal_team.style.Color = "red"
garrTeamMemberStatus(cMembers + 1) =
garrTeamMemberStatus(cMembers + 1) & vbCrLf & strMessage
Else
For i = 0 To cMembers
If document.all("cal_member_" & i).innerText =
strRecipName Then
document.all("cal_member_" & i).style.Color
= "red"
garrTeamMemberStatus(i) =
garrTeamMemberStatus(i) & vbCrLf & strMessage
End If
Next
End If
End Sub
Sub ChangeTeamMembers()
Const cDialogCaption = "Change your Team Members..."
Const cButtonCaption = "Add to my Team"
Dim bError 'As Boolean
Dim i 'As Integer
Dim strNewMemberList 'As String
Dim CDOSession 'As Object
Dim msg 'As Message
Dim recipTeamMembers 'As Recipients
Dim recip 'As Recipient
Dim strRecipName 'As String
Dim strRecipAddress 'As String
If btnTeamMembers.className = "btnFormDisabled" Then Exit Sub
'Use CDO to call MAPI address book to get a user name
Set CDOSession = GetCDO()
If CDOSession Is Nothing Then Exit Sub
Set msg = CDOSession.Outbox.Messages.Add
For i = 0 To CInt(UBound(garrTeamMembers))
strNewMemberList = strNewMemberList & ";" &
garrTeamMembers(i)(1)
Next
msg.Recipients.AddMultiple strNewMemberList
On Error Resume Next
msg.Recipients.Resolve()
strNewMemberList = vbNullString
Err.Clear()
On Error Resume Next
Set recipTeamMembers = CDOSession.Addressbook (msg.Recipients,
cDialogCaption, False, True, 1, cButtonCaption)
bError = (Err.number <> 0)
On Error Goto 0
If Not bError Then ' user did NOT cancel the addressbook dialog
For Each recip In recipTeamMembers
strRecipName = recip.Name
strRecipAddress = recip.AddressEntry.Address
' avoid doubles
If InStr(strNewMemberList, strRecipName) = 0 Then
strNewMemberList = strNewMemberList & ";" &
strRecipName & ":" & strRecipAddress
End If
Next
If Left(strNewMemberList, 1) = ";" Then
strNewMemberList = Mid(strNewMemberList, 2)
End If
End If
CDOSession.Logoff
Set CDOSession = Nothing
If strNewMemberList <> vbNullString Then
' save new team member list
SetPref cgReg_MemberList, strNewMemberList
Call GenerateTeamMembersArray()
Call HandleRefresh(true)
' refresh current page to show new team calendar links
' delay page redraw until async teamcal refresh is ready,
' so set the global redraw flag for RefreshTeamCalendar()
gbRedrawTeamCalendar = True
End If
End Sub
Sub ShowStatus(ByVal currentSpan, ByVal i)
Const cMaxChars = 600
Dim strStatus 'As String
If gbOffline And currentSpan.id <> "cal_team" Then Exit Sub ' no
individual calendars avail
If currentSpan.style.Color <> "red" Then ' don't loose error
colors
currentSpan.style.color = "black"
End If
If i < 0 Then
' set team calendar index of errors
i = CInt(UBound(garrTeamMemberStatus))
End If
If garrTeamMemberStatus(i) <> vbNullString Then
strStatus = "Following refresh error(s) occured on this
calendar:"
If Len(garrTeamMemberStatus(i)) > cMaxChars Then
strStatus = strStatus &
Left(garrTeamMemberStatus(i), cMaxChars) & "..." & vbCrLf & vbCrLf & "too
many errors to show them all here."
Else
strStatus = strStatus & garrTeamMemberStatus(i)
End If
currentSpan.title = strStatus
Else
currentSpan.title = "No refresh errors on this calendar."
End If
End Sub
Sub ShowCal(ByVal currentSpan)
Dim bError 'As Boolean
Dim i 'As Integer
Dim selectedCal 'As Integer
Dim strError ' As String
Dim cMembers 'As Integer
If gbOffline And currentSpan.id <> "cal_team" Then Exit Sub ' no
individual calendars avail
cal_team.style.fontWeight = "normal"
cal_team.style.fontSize = "8pt"
cMembers = CInt(UBound(garrTeamMembers))
For i = 0 To cMembers ' check DIVs as during adding a member the
new div doesn't yet exsist
If VarType(document.all("cal_member_" & i)) = vbString Then
document.all("cal_member_" & i).style.fontWeight =
"normal"
document.all("cal_member_" & i).style.fontSize =
"8pt"
End If
Next
currentSpan.style.fontWeight = "bold"
currentSpan.style.fontSize = "10pt"
If currentSpan.id = "cal_team" Then
ViewTeamCalendar.Folder = gstrTeamCalendarPath
If ViewTeamCalendar.Folder <> gstrTeamCalendarPath Then
MsgBox "Cannot view the Team Calendar folder " &
gstrTeamCalendarPath & _
vbCrLf & vbCrLf & "You will see your inbox
instead of your Team Calendar." , vbCritical, cgstrMsgBoxTitle
End If
Else
selectedCal = CInt(Right(currentSpan.id,
(Len(currentSpan.id) - InStrRev(currentSpan.id, "_"))))
If gbOffline Then
' restriction doesn't work with some views as e.g.
our calendar view :-(
'ViewTeamCalendar.Restriction = "[OptionalAttendees]
= '" & garrTeamMembers(selectedCal)(0) & "'"
strError = "Sorry, you can't open the calendar
folder of " & garrTeamMembers(selectedCal)(0) & vbCrLf & _
"while you're working OFFLINE."
bError = True
Else
Err.Clear()
On Error Resume Next
ViewTeamCalendar.OpenSharedDefaultFolder
garrTeamMembers(selectedCal)(1), olFolderCalendar
bError = (Err.number <> 0)
On Error Goto 0
If bError Then
strError = "Sorry, you can't open the
calendar folder of " & garrTeamMembers(selectedCal)(0) & vbCrLf & vbCrlf & _
"Try the refresh button to find out
more about why this error occured."
End If
End If
If bError Then
MarkRecipientError garrTeamMembers(selectedCal)(0),
strError
MsgBox strError, vbCritical, cgstrMsgBoxTitle
Call ShowCal(cal_team) ' navigate to the team
calendar
End If
End If
End Sub
Sub Help()
If spanHelp.style.display = vbNullString Then
' hide help / show team calendar
spanHelp.style.display = "none"
spanTeamCalendar.style.display = vbNullString
btnHelp.innerText = "Help"
Else
' show help / hide team calendar
spanHelp.style.display = vbNullString
spanTeamCalendar.style.display = "none"
btnHelp.innerText = "Calendar"
End If
End Sub
' *** FB pane BEGIN ***
Dim mbFBInitialized ' As Boolean
Dim mStartOfWeek ' As Date
Dim mIndexHour ' As Integer
Const mCellWidth = 10
Sub FB()
If btnFB.className = "btnFormDisabled" Then Exit Sub
If spanFB.style.display = vbNullString Then
' hide FB pane
spanFB.style.display = "none"
tblFB.style.display = "none"
btnFB.innerText = "Overview"
Else
' show FB pane
spanFB.style.display = vbNullString
tblFB.style.display = vbNullString
btnFB.innerText = "Hide Overview"
Call FBScroll(".") ' scroll into this week
End If
End Sub
Sub FBScroll(ByVal strWhere)
Dim today ' As Date
Dim wday ' As Integer
Select Case strWhere
Case "+" ' next week
mStartOfWeek = mStartOfWeek + 7
Case "-" ' last week
mStartOfWeek = mStartOfWeek - 7
Case Else ' "." or anything else means this week
today = Date
wday = WeekDay (today, vbMonday)
mStartOfWeek = today - wday + 1
End Select
lastRefresh.innerHTML = "<font color=black>Refreshing Team Calendar
free/busy workweek...</font>"
If Not window.event.srcElement Is Nothing Then Call
ButtonHot(window.event.srcElement, false)
Call window.setTimeout("ShowFB()", 100)
End Sub
Sub ShowFB()
Dim cMembers 'As Integer
Dim i, j 'As Integer
Dim strRecipAddress 'As String
Dim strRecipName 'As String
Dim oRecipient ' As Recipient
Dim strError ' As String
Dim newUserFB 'As Row
If mbFBInitialized Then ' clear last run
For i = tblFB.rows.length - 1 To 0 Step -1
If tblFB.rows(i).id = vbNullString Then
For j = tblFB.rows(i).cells.length - 1 To 0
Step -1
tblFB.rows(i).cells(j).removeNode()
Next
tblFB.rows(i).removeNode()
End If
Next
End If
Call FormatFBHeader()
cMembers = CInt(UBound(garrTeamMembers))
For i = 0 To cMembers
strRecipName = Trim(garrTeamMembers(i)(0))
strRecipAddress = Trim(garrTeamMembers(i)(1))
Set oRecipient = GetKnownRecipient(strRecipAddress)
If oRecipient Is Nothing Then
strError = _
"Sorry, the name " & strRecipName & " can't
be resolved from the address book!" & _
vbCrLf & vbCrLf & "Either this recipient was
not found in the address book or it resolves to more ambiguous names."
MarkRecipientError strRecipName, strError
Exit Sub
End If
Set newUserFB = tblFB.insertRow()
Call FormatFBWorkWeek (newUserFB, oRecipient)
Next
Set oRecipient = Nothing
mbFBInitialized = True
lastRefresh.innerHTML = GetPref(cgReg_LastRefresh)
End Sub
Sub FormatFBHeader()
Const cNowBGColor = "Yellow"
Dim aWeekDay(4) ' As Array
Dim CellsPerHour ' As Integer
Dim CellsPerWorkDay ' As Integer
Dim CellWidthPerWorkDay ' As Integer
Dim CellsPerWeek ' As Integer
Dim cell ' As Cell
Dim d ' As Integer
Dim IndexDay ' As Integer
Dim h ' As Integer
For d = 0 To 4
aWeekDay(d) = WeekDayName(d + 1, True, vbMonday) '
abbreviated names
Next
CellsPerHour = 60 \ gIntervalInMinutes
CellsPerWorkDay = (gEndOfWorkDay - gBeginOfWorkDay) * CellsPerHour
CellWidthPerWorkDay = mCellWidth * CellsPerWorkDay
CellsPerWeek = 1 + CellsPerWorkDay * 5
If rowDaysFB.cells.length < 2 Then ' init row as it is empty
For d = 0 to 4 ' draw weekdays
Set cell = rowDaysFB.insertCell()
With cell
.colSpan = CellsPerWorkDay
.align = "center"
.width = CellWidthPerWorkDay
.style.fontSize = 12
End With
Next
End If
For d = 0 to 4 ' draw weekdays
Set cell = rowDaysFB.cells(1 + d)
cell.innerHTML = aWeekDay(d) & "., " &
FormatDateValue(mStartOfWeek + d)
cell.style.backgroundColor = vbNullString
Next
' draw hours table row
If rowHoursFB.cells.length < 2 Then ' init row as it is empty
For d = 0 to 4
For h = gBeginOfWorkDay To gEndOfWorkDay - 1
Set cell = rowHoursFB.insertCell()
With cell
.colSpan = CellsPerHour
.align = "center"
.width = CellsPerHour * mCellWidth
.style.fontSize = 10
.innerHTML = Right("0" & h, 2)
End With
Next
Next
End If
If mIndexHour >= 0 Then
rowHoursFB.cells(mIndexHour).style.backgroundColor = vbNullString
IndexDay = Date - mStartOfWeek
If IndexDay < 0 Or IndexDay > 4 Then Exit Sub ' out of marking
range (this week)
' mark working day
rowDaysFB.cells(1 + IndexDay).style.backgroundColor = cNowBGColor
h = Hour(Time)
If h >= gBeginOfWorkDay And h <= gEndOfWorkDay Then
' mark working hour (remember, the first cell here belongs
to rowDaysFB)
mIndexHour = IndexDay * (gEndOfWorkDay - gBeginOfWorkDay) +
(Hour(Time) - gBeginOfWorkDay)
rowHoursFB.cells(mIndexHour).style.backgroundColor =
cNowBGColor
End If
End Sub
Function FormatFBWorkWeek(ByVal row, ByVal oRecipient) 'As String
Const cFreeBGColor = "LightGreen"
Const cBusyBGColor = "Red"
Dim aFBColors ' As Array
Dim strFreeBusy ' As String
Dim cell ' As Cell
Dim FBDayLength ' As Integer
Dim d ' As Integer
Dim FBDayIndex ' As Integer
Dim strFBWorkWeek ' As String
Dim i ' As Integer
Dim fb ' As Char
aFBColors = Array("White", "LightSkyBlue", "Blue", "Purple")
' olFree = 0, olTentative = 1, olBusy = 2, olOutOfOffice = 3
Err.Clear()
On Error Resume Next
strFreeBusy = oRecipient.FreeBusy(mStartOfWeek, gIntervalInMinutes,
True)
If Err.number <> 0 Then
MarkRecipientError oRecipient.Name, Err.description
End If
On Error Goto 0
FBDayLength = (gEndOfWorkDay - gBeginOfWorkDay) * (60 \
gIntervalInMinutes)
For d = 0 To 4
FBDayIndex = 1 + d * (1440 \ gIntervalInMinutes) + (60 \
gIntervalInMinutes) * gBeginOfWorkDay
strFBWorkWeek = strFBWorkWeek & Mid(strFreeBusy, FBDayIndex,
FBDayLength)
Next
If row.cells.length = 0 Then ' init row as it is empty
Set cell = row.insertCell() ' insert first cell
(friendly name)
cell.noWrap = True
If IsUserFree(oRecipient.Address, 15) Then ' check
"free" status within 15 minutes interval
cell.style.backgroundColor = cFreeBGColor
Else
cell.style.backgroundColor = cBusyBGColor
End If
cell.style.fontSize = 12
cell.style.cursor = "hand"
cell.title = "send meeting request to " & oRecipient.Name
'cell.style.textDecorationUnderline = True
cell.innerHTML = " <span
onclick=""javascript:MakeAppt('" & oRecipient.Address & "');""
onmouseover=""javascript:LabelHot(this, true);""
onmouseout=""javascript:LabelHot(this, false);"">" & oRecipient.Name &
"</span>"
For i = 1 To Len(strFBWorkWeek)
Set cell = row.insertCell()
cell.innerHTML = " "
cell.width = mCellWidth
Next
End If
For i = 1 To Len(strFBWorkWeek)
Set cell = row.cells(i)
fb = Mid(strFBWorkWeek, i, 1)
cell.style.backgroundColor = aFBColors(CInt(fb))
Next
FormatFBWorkWeek = strFBWorkWeek
End Function
' *** FB pane END ***
Sub Config(ByVal bSave)
Dim i 'As Integer
Dim bRedrawTeamCalendar 'As Boolean
Dim bRefreshTeamCalendar 'As Boolean
Dim strTeamDescription 'As String
If bSave = 9 And btnConfig.className = "btnFormDisabled" Then Exit
Sub
' toggle configuration pane
If spanConfig.style.display = vbNullString Then
' save configuration
spanConfig.style.display = "none"
If Not gbOffline Then btnRefresh.className = "btnForm"
btnConfig.className = "btnForm"
If Not bSave Then
gstrFilter = Trim(GetPref(cgReg_Filter)) '
reread last filter
Exit Sub ' user canceled saving
End If
strTeamDescription = txtTeamDesc.value
If strTeamDescription = vbNullString Then strTeamDescription
= cgstrDefaultDescription
TeamDesc.innerText = strTeamDescription
SetPref cgReg_TeamDescription, strTeamDescription
gbAskForRefresh = chkAskForRefresh.checked
SetPref cgReg_AskForRefresh, gbAskForRefresh
gbShowOverview = chkShowOverview.checked
SetPref cgReg_ShowOverview, gbShowOverview
If gBeginOfWorkDay <> CInt(cboFBStart.value) Then
' FB setting changed (header must be redrawed)
gBeginOfWorkDay = cboFBStart.value
SetPref cgReg_BeginOfWorkDay, gBeginOfWorkDay
bRedrawTeamCalendar = True ' team calendar
needs to be redrawed
End If
If gEndOfWorkDay <> CInt(cboFBEnd.value) Then
' FB setting changed (header must be redrawed)
gEndOfWorkDay = cboFBEnd.value
SetPref cgReg_EndOfWorkDay, gEndOfWorkDay
bRedrawTeamCalendar = True ' team calendar
needs to be redrawed
End If
If gIntervalInMinutes <> CInt(cboFBInterval.value) Then
' FB setting changed (header must be redrawed)
gIntervalInMinutes = cboFBInterval.value
SetPref cgReg_IntervalInMinutes, gIntervalInMinutes
bRedrawTeamCalendar = True ' team calendar
needs to be redrawed
End If
If gbIncludeRecurrences <> chkIncludeRecurrences.checked
Then
' recurrences filter changed
gbIncludeRecurrences = chkIncludeRecurrences.checked
SetPref cgReg_IncludeRecurences,
gbIncludeRecurrences
bRefreshTeamCalendar = True ' team calendar
needs refresh
End If
If gNumberOfDays <> cboNumberOfDays.value Then
' day forecast changed
gNumberOfDays = cboNumberOfDays.value
SetPref cgReg_NumberOfDays, gNumberOfDays
bRefreshTeamCalendar = True ' team calendar
needs refresh
End If
If gstrFilter <> cboFilter.value Then
' filter has changed, custom filter is already set
so don't set it here
If cboFilter.selectedindex > 0 Then
gstrFilter = cboFilter.value
End If
SetPref cgReg_Filter, Trim(gstrFilter)
bRefreshTeamCalendar = True ' team calendar
needs refresh
End If
If bRedrawTeamCalendar Then ' team calendar needs to be
redrawed
' refresh current page to show new free/busy layout
document.execCommand("Refresh")
End If
Call HandleRefresh(bRefreshTeamCalendar)
Else
' show configuration
spanConfig.style.display = vbNullString
txtTeamDesc.value = TeamDesc.innerText
chkAskForRefresh.checked = gbAskForRefresh
chkIncludeRecurrences.checked = gbIncludeRecurrences
cboNumberOfDays.value = gNumberOfDays
cboFilter.value = gstrFilter
If cboFilter.selectedIndex = -1 Then cboFilter.selectedIndex
= 0 ' select custom
gstrMemberList = Trim(GetPref(cgReg_MemberList)) '
reload member list if user canceled a changed member list before
cboFBStart.value = gBeginOfWorkDay
cboFBEnd.value = gEndOfWorkDay
cboFBInterval.value = gIntervalInMinutes
chkShowOverview.checked = gbShowOverview
btnRefresh.className = "btnFormDisabled"
Call ButtonHot(btnConfig, False)
btnConfig.className = "btnFormDisabled"
End If
End Sub
Sub HandleRefresh(ByVal bRefreshTeamCalendar)
If bRefreshTeamCalendar Then ' members or day forcast or filter
changed
If gbOffline Then
MsgBox "Your changes are saved but can't be applied
while you are working OFFLINE." & vbCrLf & _
"Use the ""Refresh"" button the next time
you're online again to reflect your changed settings.", vbExclamation,
cgstrMsgBoxTitle
Else
Call DoRefreshTeamCalendar() ' refresh without
asking
End If
End If
End Sub
Sub CheckForCustomFilter()
If cboFilter.selectedindex = 0 And window.event.button = 2 Then '
rightmouse click on item 0
gstrFilter = Trim(InputBox("Create/Edit your custom filter
here:" & vbCrLf & vbCrLf & _
"e.g. [Categories] = ""Holiday""" & vbCrLf & vbCrLf
& _
"(see the Online Help for details about how to write
a custom filter).", _
"Custom Filter Editor", gstrFilter))
End If
End Sub
Sub DisplayFilter()
Dim p, i 'As Integer
Dim strFilterText 'As String
gstrFilter = Trim(GetPref(cgReg_Filter))
p = 0
For i = 0 + 1 To cboFilter.options.length - 1
If cboFilter.options(i).value = gstrFilter Then
p = i ' standard filter
End If
Next
If p > 0 Then ' standard filter
strFilterText = "Filtered on <i>" &
cboFilter.options(p).Text & "</i>"
Else
strFilterText = "Using custom filter: <i>" & gstrFilter &
"</i>"
End If
If gbIncludeRecurrences Then
strFilterText = strFilterText & " (including recurrences)"
End If
If gbOffline Then
strFilterText = "<font color=red>OFFLINE</font> - " &
strFilterText
End If
FilterText.innerHTML = strFilterText
End Sub
Sub ButtonHot(ByVal div, ByVal bHot)
If div.className = "btnFormDisabled" Then Exit Sub
If bHot Then
div.style.borderColor = "DarkCyan"
div.style.color = "black"
Else
div.style.borderColor = "Gainsboro"
div.style.color = "slategray"
End If
End Sub
Sub LabelHot(ByVal div, ByVal bHot)
If div.style.Color = "red" Then Exit Sub ' don't loose error
colors
If bHot Then
div.style.color = "black"
Else
div.style.color = "slategray"
End If
End Sub
</Script>
<Script LANGUAGE=vbscript FOR=window EVENT=onload>
Dim bError 'As Boolean
Dim bAppError 'As Boolean
Dim strTeamDescription 'As String
Dim strLastRefresh 'As String
If gbRunningInOutlook Then
If gThisFolder.DefaultItemType = olAppointmentItem Then
If gThisFolder =
gNamespace.GetDefaultFolder(olFolderCalendar) Then
thePage.style.display = "none"
MsgBox "You can't install this folder homepage into
your default calendar folder, reinstall into another calendar folder!",
vbCritical, cgstrMsgBoxTitle
bAppError = True
End If
Else
thePage.style.display = "none"
MsgBox "This folder is not a calendar folder, reinstall this
folder homepage into a folder of type calendar!", vbCritical,
cgstrMsgBoxTitle
bAppError = True
End If
If Not bAppError Then
strTeamDescription = Trim(GetPref(cgReg_TeamDescription))
If strTeamDescription = vbNullString Then strTeamDescription
= cgstrDefaultDescription
TeamDesc.innerText = strTeamDescription
strLastRefresh = GetPref(cgReg_LastRefresh)
If gstrMemberList <> vbNullString And strLastRefresh <>
vbNullString Then
lastRefresh.innerHTML = strLastRefresh
End If
gNumberOfDays = Trim(GetPref(cgReg_NumberOfDays))
If gNumberOfDays = vbNullString Then gNumberOfDays = "0"
' default is today
gbAskForRefresh = GetPref(cgReg_AskForRefresh)
If gbAskForRefresh = vbNullString Then gbAskForRefresh = "0"
' default is no refresh
gbAskForRefresh = CBool(gbAskForRefresh)
gbIncludeRecurrences = GetPref(cgReg_IncludeRecurences)
If gbIncludeRecurrences = vbNullString Then
gbIncludeRecurrences = "1" ' default is include recurrences
gbIncludeRecurrences = CBool(gbIncludeRecurrences)
gBeginOfWorkDay = GetPref(cgReg_BeginOfWorkDay)
If gBeginOfWorkDay = vbNullString Then gBeginOfWorkDay = 8
gBeginOfWorkDay = CInt(gBeginOfWorkDay)
gEndOfWorkDay = GetPref(cgReg_EndOfWorkDay)
If gEndOfWorkDay = vbNullString Then gEndOfWorkDay = 18
gEndOfWorkDay = CInt(gEndOfWorkDay)
gIntervalInMinutes = GetPref(cgReg_IntervalInMinutes)
If gIntervalInMinutes = vbNullString Then gIntervalInMinutes
= 30
gIntervalInMinutes = CInt(gIntervalInMinutes)
gbShowOverview = GetPref(cgReg_ShowOverview)
If gbShowOverview = vbNullString Then gbShowOverview = "0"
' default is no overview at startup
gbShowOverview = CBool(gbShowOverview)
Call DoLocalization()
' check if the Outlook View Control is installed (minimum
Outlook9 version of the view control or higher >=9,0,0,2323)
' (downsized this from our earlier requirement of
9,0,0,3203)
' if a view control cannot be found, then we provide a
codebase tag with a download url of the
' Active-X Gallery at
"http://activex.microsoft.com/activex/controls/office/outlctlx.cab";
' Outlook9: OUTLCTL.DLL; 9,0,0,2323
' Outlook10: OUTLCTL.DLL; 10,0,2616,0
' Active-X Gallery (earlier version): OUTCTLX.DLL;
9,0,0,3203
' Active-X Gallery (last version): OUTCTLX.DLL; 10,0,0,3124
Err.Clear()
On Error Resume Next
' try to set a property, if this fails with error 438 then
the control is not installed and also was not downloaded from the codebase
url
' we use this install-test with the side-effect to set the
right view for team calendar
ViewTeamCalendar.View = gstrLocalized_TeamCalendarViewName
' dont use this error checking, because setting a view
before setting the folder property produces errors on some control versions
even if the control works as expected
'bError = (Err.number <> 0)
' we now use a more safety way to differenciate between view
setting errors or control absence
bError = (Err.number = 438) ' which is "Object doesn't
support this property or method"
On Error Goto 0
If bError Then
MsgBox "Sorry, you need the Outlook View Axtive-X
Control installed on your machine. " & _
"Either install this control by hand or just
connect to the Internet and refresh this page again to autoinstall this
control from the Microsoft Website.", _
vbCritical, cgstrMsgBoxTitle
bAppError = True
Else
Call DisplayFilter
Call ShowCal(cal_team)
If gbOffline Then
' disable some UI not useful in offline mode
btnRefresh.className = "btnFormDisabled"
btnTeamMembers.className = "btnFormDisabled"
btnFB.className = "btnFormDisabled"
Else
Call RefreshTeamCalendar(True) ' refresh if
user has checked auto-refresh on page load
Call RenderTeamInvite()
If gbShowOverview Then Call FB()
End If
End If
End If
Else
bAppError = True
End If
If bAppError Then
' disable UI
rowMenu.style.display = "none"
rowInfo.style.display = "none"
' and show help
Call Help()
End If
</Script>
<STYLE ID="TeamCalStyles" TYPE="text/css">
BODY {
COLOR: slategray;
BACKGROUND-COLOR: Beige;
FONT-FAMILY: Verdana;
}
H1, H2, H3 {
FONT-WEIGHT: bold;
margin-bottom: .5em;
}
H1 {
FONT-SIZE: 145%;
}
H2 {
FONT-SIZE: 125%;
margin-top: 1.5em;
}
H3 {
font-size: 115%;
margin-top: 1.2em;
}
LI {
margin-top: .75em;
margin-bottom: .75em;
}
.TeamDesc {
FONT-SIZE: 16pt;
FONT-WEIGHT: bold;
}
.FilterText {
FONT-SIZE: 12pt;
}
.RefreshInfo {
FONT-SIZE: 10pt;
}
.btnCal, .btnCalDisabled {
CURSOR: hand;
FONT-SIZE: 8pt;
TEXT-ALIGN: center;
WIDTH: 0px;
BORDER-BOTTOM: 0px;
BORDER-LEFT: 0px;
BORDER-RIGHT: black 1px solid;
BORDER-TOP: 0px;
PADDING-LEFT: 4px;
PADDING-RIGHT: 4px;
PADDING-TOP: 1px;
PADDING-BOTTOM: 1px;
MARGIN: 0px 1px 0px 0px;
}
.btnCalDisabled {
TEXT-DECORATION: line-through;
CURSOR: default;
}
.btnForm, .btnFormDisabled, .btnWeb {
CURSOR: hand;
FONT-SIZE: 10pt;
FONT-WEIGHT: bold;
TEXT-ALIGN: center;
WIDTH: 120px;
border-width: 1px;
border-style: solid;
border-color: Gainsboro;
padding-left: 3px;
padding-right: 3px;
padding-top: 3px;
padding-bottom: 3px;
margin-top: 14px;
margin-bottom: 7px;
}
.btnFormDisabled {
TEXT-DECORATION: line-through;
CURSOR: default;
}
.btnWeb {
FONT-FAMILY: WebDings;
FONT-SIZE: 14pt;
WIDTH: 0px;
padding-left: 0px;
padding-right: 0px;
padding-top: 0px;
padding-bottom: 0px;
}
.FormText, .FormTextHot {
FONT-SIZE: 10pt;
}
.FormTextHot, .HelpText {
COLOR: black;
}
</STYLE>
</HEAD>
<BODY id="thePage" MARGINHEIGHT="0" MARGINWIDTH="0" scroll="auto"
oncontextmenu="javascript:return false;">
<table id="tblMain" style="PADDING-BOTTOM: 4px; PADDING-LEFT: 4px;
PADDING-RIGHT: 4px; PADDING-TOP: 4px" border="0" width="100%"
cellspacing="0" cellpadding="0">
<tr id="rowMenu">
<td width="20%" align="middle" valign="top">
<span id="btnFB" class="btnForm" onclick="call FB()"
onmouseover="call ButtonHot(me, true)" onmouseout="call ButtonHot(me,
false)"
title="Free/Busy Status pane of the Team Members
workweek">
Overview
</span>
</td>
<td width="20%" align="middle" valign="top">
<span id="btnConfig" class="btnForm" onclick="call
Config(9)" onmouseover="call ButtonHot(me, true)" onmouseout="call
ButtonHot(me, false)"
title="Define your Personal Preferences">
Personalize
</span>
</td>
<td width="20%" align="middle" valign="top">
<span id="btnRefresh" class="btnForm"
onclick="DoRefreshTeamCalendar()" onmouseover="call ButtonHot(me, true)"
onmouseout="call ButtonHot(me, false)"
title="Refresh this Team Calendar">
Refresh
</span>
</td>
<td width="20%" align="middle" valign="top">
<span id="btnTeamMembers" class="btnForm"
onclick="ChangeTeamMembers()" onmouseover="call ButtonHot(me, true)"
onmouseout="call ButtonHot(me, false)"
title="Define your Team Members">
Team Members
</span>
</td>
<td width="20%" align="middle" valign="top">
<span id="btnHelp" class="btnForm" onclick="Help()"
onmouseover="call ButtonHot(me, true)" onmouseout="call ButtonHot(me,
false)"
title="Get Help and Information">
Help
</span>
</td>
</tr>
<tr id="rowInfo">
<td colspan="2">
<span id="TeamLogo" style="FONT-FAMILY: WebDings;
FONT-SIZE: 30pt">”</span>
<span id="TeamDesc" class="TeamDesc"></span>
</td>
<td colspan="3" align="right">
<div id="FilterText" class="FilterText"></div>
<div id="lastRefresh" class="RefreshInfo">Define
your Team Members</div>
</td>
</tr>
<span id="spanFB" style="DISPLAY: none">
<tr><td colspan="9">
<table id="tblFB" style="DISPLAY: none" bordercolor="gray"
border="1" height="100%" width="100%" cellspacing="0"
cellpadding="0">
<tr id="rowDaysFB"><td id="cellScrollFB" rowspan="2"
width="120" nowrap align="middle" valign="center">
<span class="btnWeb" onclick="FBScroll('-')"
onmouseover="call ButtonHot(me, true)" onmouseout="call ButtonHot(me,
false)"
title="previous workweek">3</span>
<span class="btnWeb" onclick="FBScroll('.')"
onmouseover="call ButtonHot(me, true)" onmouseout="call ButtonHot(me,
false)"
title="this workweek">q</span>
<span class="btnWeb" onclick="FBScroll('+')"
onmouseover="call ButtonHot(me, true)" onmouseout="call ButtonHot(me,
false)"
title="next workweek">4</span>
</td></tr>
<tr id="rowHoursFB"></tr>
</table>
</td></tr>
</span>
<span id="spanConfig" style="DISPLAY: none">
</table>
<table style="PADDING-BOTTOM: 4px; PADDING-LEFT: 4px; PADDING-RIGHT: 4px;
PADDING-TOP: 4px" border="0" width="100%" cellspacing="0" cellpadding="0">
<tr><td colspan="2"><hr></td></tr>
<tr>
<td><div class="FormText" onmouseover="call LabelHot(me,
true)" onmouseout="call LabelHot(me, false)">
<u>D</u>escription of this Team: <INPUT
type=textbox id="txtTeamDesc" size="40" accesskey="d" class="FormTextHot">
</div></td>
<td align="right">
<span id="btnSave" class="btnForm" onclick="call
Config(true)" onmouseover="call ButtonHot(me, true)" onmouseout="call
ButtonHot(me, false)"
title="save my preferences">
Save
</span>
<span id="btnCancel" class="btnForm" onclick="call
Config(false)" onmouseover="call ButtonHot(me, true)" onmouseout="call
ButtonHot(me, false)"
title="cancel my changes">
Cancel
</span>
</td>
</tr>
<tr>
<td><div class="FormText" onmouseover="call LabelHot(me,
true)" onmouseout="call LabelHot(me, false)">
<u>R</u>ead
<SELECT id="cboNumberOfDays" accesskey="r"
class="FormTextHot">
<OPTION value=0 selected>today
<OPTION value=1>next 2 days
<OPTION value=2>next 3 days
<OPTION value=3>next 4 days
<OPTION value=w>this work week (5 days)
<OPTION value=w+>this week and next week
<OPTION value=-w>last week and this week
<OPTION value=-w+>this week and the 2
surounding weeks
<OPTION value=m>this month
<OPTION value=m+>this month and next month
</SELECT>
into this Team Calendar.
</div></td>
<td align="right"><div class="FormText" onmouseover="call
LabelHot(me, true)" onmouseout="call LabelHot(me, false)">
<INPUT type=checkbox id="chkAskForRefresh"
accesskey="a"><u>A</u>sk for refresh when loading this page
</div></td>
</tr>
<tr>
<td><div class="FormText" onmouseover="call LabelHot(me,
true)" onmouseout="call LabelHot(me, false)">
Apply following <u>F</u>ilter
<SELECT id="cboFilter"
onchange="CheckForCustomFilter()" onmouseup="CheckForCustomFilter()"
accesskey="f" class="FormTextHot">
<OPTION value="custom" selected><Custom
Filter (see Online Help)>
<OPTION value="">All Appointments
</SELECT>
on all items on retrieval.
</div></td>
<td align="right"><div class="FormText" onmouseover="call
LabelHot(me, true)" onmouseout="call LabelHot(me, false)">
<INPUT type=checkbox id="chkIncludeRecurrences"
accesskey="i"><u>I</u>nclude recurring appointments
</div></td>
</tr>
<tr>
<td><div class="FormText" onmouseover="call LabelHot(me,
true)" onmouseout="call LabelHot(me, false)">
<u>S</u>how workday overview from
<SELECT id="cboFBStart" accesskey="s"
class="FormTextHot">
<OPTION value="6" selected>06:00
<OPTION value="7">07:00
<OPTION value="8">08:00
<OPTION value="9">09:00
<OPTION value="10">10:00
<OPTION value="11">11:00
</SELECT>
<u>u</u>ntil
<SELECT id="cboFBEnd" accesskey="u"
class="FormTextHot">
<OPTION value="13" selected>13:00
<OPTION value="14">14:00
<OPTION value="15">15:00
<OPTION value="16">16:00
<OPTION value="17">17:00
<OPTION value="18">18:00
<OPTION value="19">19:00
<OPTION value="20">20:00
</SELECT>
i<u>n</u>
<SELECT id="cboFBInterval" accesskey="n"
class="FormTextHot">
<OPTION value="15" selected>15
<OPTION value="30">30
<OPTION value="60">60
</SELECT>
minutes interval.
</div></td>
<td align="right"><div class="FormText" onmouseover="call
LabelHot(me, true)" onmouseout="call LabelHot(me, false)">
<INPUT type=checkbox id="chkShowOverview"
accesskey="o">Show <u>O</u>verview at startup
</div></td>
</tr>
<tr><td colspan="2"><hr></td></tr>
</table></SPAN>
<span id="spanTeamCalendar">
<tr><td colspan = "9">
<table border="0" width="100%" cellpadding="0"
cellspacing="0">
<tr><td nowrap width="100%">
<span id="cal_team" onclick="ShowCal(me)" class="btnCal"
onmouseover="call ShowStatus(me, -1)" onmouseout="call LabelHot(me,
false)">Team Calendar</span>
<script language="vbscript">
Dim i 'As Integer
Dim cMembers 'As Integer
Dim strCalClass ' As String
If gbRunningInOutlook Then
cMembers = CInt(UBound(garrTeamMembers))
If gbOffline Then
strCalClass = "btnCalDisabled"
Else
strCalClass = "btnCal"
End If
Const cMaxMembersPerRow = 5
For i = 0 To cMembers
If (i > 0) And (i Mod
cMaxMembersPerRow = 0) Then
document.writeln
"</td></tr><tr><td nowrap>" & vbCrLf
End If
document.writeln "<span id=""cal_member_" &
i & """ class=""" & strCalClass & """ onclick=""ShowCal(me)""
onmouseover=""call ShowStatus(me, " & i & ")"" onmouseout=""call
LabelHot(me, false)"">" & garrTeamMembers(i)(0) & "</span>"
Next
End If
</script>
</td></tr>
</table>
</td></tr>
<tr>
<TD valign="top" colspan="9" width="100%" height="100%">
<OBJECT id=ViewTeamCalendar
classid=CLSID:0006F063-0000-0000-C000-000000000046
codebase="http://activex.microsoft.com/activex/controls/office/outlctlx.cab#
version=9,0,0,2323" width="100%" height="85%">
<param name="View" value>
<param name="Folder" value>
<param name="Namespace"
value="MAPI">
<param name="Restriction" value>
<param name="DeferUpdate" value="0">
</OBJECT>
</TD>
</tr>
</span>
<span id="spanHelp" style="DISPLAY: none">
<table style="PADDING-BOTTOM: 4px; PADDING-LEFT: 4px; PADDING-RIGHT: 4px;
PADDING-TOP: 4px" border="0" width="100%" cellspacing="0" cellpadding="0">
<tr><td class="HelpText">
<H1>Outlook Team Calendar Application V 2.2</H1>
<UL>
<LI><A href="#overview">Overview</A>
<LI><A href="#setup">Setting Up the Team Calendar</A>
<LI><A href="#customize">Personalize and Configure the Team
Calendar</A>
<LI><A href="#multiple_teamcals">Using more than one Team
Calendar</A>
<LI><A href="#offline_support">Offline Support of Team Calendar</A>
<LI><A href="#language_support">Language Support</A>
<LI><A href="#date_issues">Possible Date Issues</A>
<LI><A href="#warranty">Warranty</A></LI>
</UL>
<H1><A NAME="overview"></A>Overview</H1>
Outlook Team Calendar is a Personal Outlook 2000 Folder Homepage.
<br><br>
The idea is to have a <b>single view</b> of choosen Team Member appointments
as well as enable quick access to their individual calendars and their
free/busy times.
<br><br>
<b>Requirements:</b> You need to run this page from within Outlook 2000 and
you need access to Microsoft Exchange Server to use Team Calendar.
<br><br>
<big><b>Where is the software to install from?</b></big>
<br>
When you read this page you already have all the neccesary code you need ;-)
<br>
Team Calendar detects if you are viewing this page from an Outlook folder
homepage or outside Outlook i.e. in Internet Explorer. In this last case, it
only shows this
help pane and hides the rest of the Team Calendar application.
<br><br>
Team Calendar uses your existing Outlook Objects, the Outlook View Control,
Collaboration Data Objects,
Dynamic (D)HTML, Cascading Style Sheets, Configuration Management via the
Registry, all of this within this *one* single HTML-File - named
"teamcal.htm".
<br><br>
<b>No additional code is required</b> as the Team Calendar downloads CDO and
the Outlook View Control directly from the Internet, if not already
installed.
<H1><A NAME="setup"></A>Setting Up the Team Calendar</H1>
To setup the Team Calendar do the following:
<OL>
<LI>
First you should save this page - teamcal.htm - somewhere onto your
harddisk, e.g. C:\My Documents\teamcal.htm.
<LI>
Create an outlook subfolder anywhere you want - e.g. a subfolder of your
mailbox's calendar folder,
with a name of your choice. The folder must be of type calendar - contains
appointment items - and doesn't have to be your own
calendar folder. You should use your mailbox store or a personal store for
this folder and not a public folder as this is
supposed to be a personal solution and the settings of this are all stored
in your registry and not in the folder itself.
<LI>
Right-click your newly created folder, choose "Properties" and
activate the "Home Page" tab.
Use the "Browse..." button to pickup this file
("teamcal.htm") from where you saved it in
Step 1 and make sure to activate the "Show home page by default for
this folder" checkbox.
<LI>
Use the <big><b>Personalize</b></big> button on the folder homepage to
define your own title message, refresh properties,
filters and the days you want to look ahead.
<LI>
Define your team members (which uses CDO for the addressbook dialog - it
will prompt you to install CDO if neccesary) and make sure you've at least
read access to your team member calendars.
Whenever you change your team members or filter preferences the page will
refresh automatically after saving the changes with the
<big><b>Save</b></big> button.
</LI>
</OL>
N.B. If you choose to download CDO from the Microsoft Website you have to
install and register CDO manually. See the readme.txt which comes with the
download for instructions how to do this.
The preferred - and easier - option is to install CDO from your
Office/Outlook 2000 setup where you can add it from the list of available
components.
<H1><A NAME="customize"></A>Personalize and Configure the Team Calendar</H1>
You define the members of a Team Calendar with the <b>Team Members</b>
button to define, edit or delete your Team Members. This
team definition - as all other configuration settings - is persisted in your
user registry and is part of your user profile.
<br>
N.B. Team Members are saved with both their display name and their X.400
address as their primary lookup key.
<br><br>
The page can be configured to automatically refresh on load. The
<big><b>Refresh</b></big> button can also be used to refresh at any time you
want.
Every refresh will first delete all existing appointments within the Team
Calendar.
<br><br>
The last refresh filter and refresh time always show up in the page header
for your information.<br>
The Team Calendar application filters all team member calendars for
appointments based on both the time and filter you choose and copies these
items into the team calendar.
<br><br>
The result is a condensed view of all your Team Member appointments. To
distinguish the source of the appointment all subjects are prefixed with the
Team Member's name as eg.
"[Roman Lutz]: my subject". The Team Member's name is also copied
to the "OptionalAttendees" field of the generated Team Calendar
appointment to mark the source of the appointment
and allow easy grouping / filtering of individual Team Members.
<br><br>
To allow quick access to the Team Member individual calendars a
"navigation bar" is build to open each Team Member's individual
calendar from this folder homepage.
The page layout should automatically fit into your folder's pane.
<br><br>
The <big><b>Personalize</b></big> button allows the configuration of the
Team Calendar. It shows you a configuration pane where you can set your
preferences about each individual Team Calendar.
The time intervals you want to read ahead are called the
"Timefilter". In addition to the time interval you can add another
property filter from the filter dropdown combo box.
<br>
There are already some pre-configured property filters from which you can
choose or - with the first option in the list
named "<Custom Filter>" - define your own property filter.
To launch the Custom Filter Editor you have to <b>Right-click</b>
this first option and enter a valid filter expression.
<br><br>
Valid filters are Boolean expressions concatenated with "NOT",
"AND", "OR". The expression only accepts static values
and
all outlook properties you use in your expression have to be surrounded with
square brackets "[]".
<br><br>
An example of a valid custom filter would be: [Categories] =
"Holiday". This example can also be found in the filterlist at the
very end. See the Outlook Visual Basic Online Help for more information
about user-defined filters.
<br><br>
N.B. some custom filters - as e.g. the last Holiday filter require you to
<b>clear</b> the "include recurring appointments" checkbox to get
any results back from
the custom filter. Be also aware that Outlook property names depend on the
installed language for Outlook, e.g. the correct name for the
"Categories" property in a German Outlook installation is
"Kategorien".
<br><br><br>
Even if you are running Outlook 2000 US and do not need to localize the Team
Calendar you may want to have a look at the
<b>"teamcal-german.reg"</b> file to
learn how you can add more then one custom filter to the Team Calendar
filterlist.
<br><br>
<b>Do not double-click</b> the "teamcal-german.reg" file on an US
Outlook installation, as this would <b>localize</b> the "Start"
property to the name "Beginn" -German- and never get any
appointments into your Team Calendar.
<br><br>
If you get messed up with this regfile by accident you may want to
(carefully) delete all values starting with
"DD_TeamCal_Localized_" under the registry key
[HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Outlook\Today].
<H1><A NAME="multiple_teamcals"></A>Using more than one Team Calendar</H1>
You can use this solution in as many folders as you want simultaneously -
each of it with it's one team definition.
The name of each folder containing an instance of a Team Calendar has to be
unique accross all stores (as the folder name is used as key).
<H1><A NAME="offline_support"></A>Offline Support of Team Calendar</H1>
The Team Calendar has great offline support. If you <b>mark the Team
Calendar folder for offline usage</b> - or use them within a PST
store - you can easily take the Team Calendar offline.
The Team Calendar auto-detects if you are running online or offline from
your Exchange Server and disables UI components in offline mode.
<br><br>
Defining Team Members, the Free/Busy Overview, refreshing or accessing the
individual Team Member calendars is not possible when working offline.
Disabled components are shown with a line-through effect like <span
style="COLOR: slategray; TEXT-DECORATION: line-through">disabled</span>.
<H1><A NAME="language_support"></A>Language Support</H1>
Team Calendar should run fine on any Windows version with <b>Outlook 2000
US</b> and any language settings without any changes.
If you encounter errors in your filter during refresh showing date problems,
try to <b>synchronize</b> your user dateformat with the system dateformat.
See the below <A href="#date_issues">Possible Date Issues</A> section to
learn more about why this can happen and how to resolve this issue.
<br><br>
To run Team Calendar on <b>NON-US languages of Outlook 2000</b> you will
have to apply (merge) the corresponding localization registry file, e.g.
"teamcal-german.reg" if your Outlook installation language is
German.
For any language you want to use in your Team Calendar - for languages other
than US, GERMAN or FRENCH - you first have to create a registry file based
on the German template and change it to your needs.
(see the inline comments in the "teamcal-german.reg" file to learn
how to create a new template or how to use parts of this registry file to
add additional custom filters).
<H1><A NAME="date_issues"></A>Possible Date Issues</H1>
If your system dateformat settings are not or cannot be the same as your
user dateformat settings, then Team Calendar has to calculate a reference
dateformat guessing your user dateformat. This is neccesary because
the used VBScript function FormatDateTime() uses the system dateformat
settings but the Outlook Find() and Restrict() methods work with the user
dateformat settings and would only get results back,
if the user locale is the same as the system locale - regardless in which
language you are working.
<br><br>
If that does not work you'll get a filter error message back from the Team
Calendar. To be sure that you really have this date problem - and if you
need this sync - try to apply the
"All Apointments" filter and use the "This month"
timefilter.
<br><br>
To <b>synchronize the user with the system settings</b> you should check the
"set as system default locale" checkbox in the "Regional
Settings"
control panel applet (NT4) or use the "Set default..." button of
the "Regional Options" (Windows 2000).
This may require the Windows Installation CD and you will have to reboot
your system after changing the system locale.
<H1><A NAME="warranty"></A>Warranty</H1>
THE TEAMCAL.HTM AND EMBEDDED SCRIPT CODE IS PROVIDED "AS IS"
WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT
LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
PARTICULAR PURPOSE.
</td></tr>
</table>
</span></TABLE>
</BODY>
</HTML>
Michael Woodruff
System Administrator
inChord Communications Inc.
A group of communications companies providing clients unlimited visibility
614.543.6405
[EMAIL PROTECTED]
_________________________________________________________________
List posting FAQ: http://www.swinc.com/resource/exch_faq.htm
Archives: http://www.swynk.com/sitesearch/search.asp
To unsubscribe: mailto:[EMAIL PROTECTED]
Exchange List admin: [EMAIL PROTECTED]
