Article ID: 186753
Article Last Modified on 6/6/2005
Private Sub Command1_Click()
Dim ObjSession As MAPI.Session
Dim ObjMessage As Message
Dim ObjAddressEntry As AddressEntry
Set ObjSession = CreateObject("mapi.session")
ObjSession.Logon profilename:="YourProfileName"
Set ObjMessage = ObjSession.Inbox.Messages.Add
Set ObjRecipColl = ObjMessage.Recipients
Set ObjOneRecip = ObjRecipColl.Add
'Type the alias of the person or the resource account.
ObjOneRecip.Name = "JoeDoe"
ObjOneRecip.Resolve
Set ObjAddressEntry = ObjOneRecip.AddressEntry
'Specify the date/time of the beginning of the first time slot.
StartTime="1998/06/03 8:00:00 AM"
'Specify the date/time of the end of the last time slot.
EndTime="1998/06/03 10:00:00 AM"
'Specify the length of each time slot in minutes.
'If Interval parameter is less than 1, GetFreeBusy returns
'CdoE_INVALID_PARAMETER.
Interval=60
'Interval parameter determines the number of time slots.
'For this example, Interval is set to 60 minutes. Therefore,
'there will be 2 time slots between the StartTime and the EndTime.
'The first time slot is between 8:00:00-9:00:00 AM.
'The second time slot is between 9:00:00-10:00:00 AM.
FreeBusy = ObjAddressEntry.GetFreeBusy(StartTime, EndTime, _
Interval)
'Since there are two time slots, the GetFreeBusy method returns a
'string with length 2. For example, FreeBusy = "21" indicates that
'there is a tentative commitment during the time slot 1. Also,
'there is a confirmed commitment during the time slot 2.
Msg = ""
For i = 1 To Len(FreeBusy)
Select Case Mid(FreeBusy, i, 1)
Case "0"
TempMsg = "Available for meetings/appointments during " & _
"the time slot " & i & vbLf
Case "1"
TempMsg = "At least one tentative commitment during " & _
"the time slot " & i & vbLf
Case "2": TempMsg = "At least one confirmed commitment " & _
"during the time slot " & i & vbLf
Case "3": TempMsg = "Out-of-office (OOF) for at least " & _
"part of the time slot " & i & vbLf
End Select
Msg = Msg + TempMsg
Next
MsgBox Msg
ObjSession.Logoff
Set ObjMessage = Nothing
Set ObjRecipColl = Nothing
Set ObjOneRecip = Nothing
Set ObjAddressEntry = Nothing
Set ObjSession = Nothing
End Sub
Keywords: kbhowto kbmsg kbcode KB186753