Calendar free times to mail message

[Ripin]

I'll need vba code to collect free times from my calendar to a body of a mail message. It should only use times between working hours.

There should have start and end date, and it should't collect pastitems.
That maybe can done by vba, but I haven't find code or good add-in.

Outlook 2007 have that, but I only want free times, that's all.

I'll tryed attached code, but it returs info and I don't know howto format it. I allso need info how to get start and end day and only working hours, not just one day.

I's there any things that don't work in differend versions?

Public Sub GetFreeBusyInfo()
Dim myNameSpace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim myFBInfo As String
Set myNameSpace = Application.GetNamespace("MAPI")
Set myRecipient = myNameSpace.CreateRecipient("MEKROTH")
On Error GoTo ErrorHandler
myFBInfo = myRecipient.FreeBusy(#2/2/2008#, 60 * 24)
MsgBox myFBInfo
Exit Sub
ErrorHandler:
MsgBox "Cannot access the information. "
End Sub

[Demosthine]

Good Evening.

What you are requesting is very feasible using the FreeBusy function built into Microsoft Outlook. I must note, however, that in order to return any Recipient other than the local machine, Microsoft Outlook must be connected to an active Microsoft Exchange Server and the requested user must have their calendar available for public access. Any items that are marked Private will not appear.

That being said, I have written a small function that requires several arguments to be passed: Start Date, End Date, Start Of Day, End of Day, and IntervalPeriod. It will retrieve the necessary information and format it into an easy-to-read schedule that is primarily vertical. In the interest of you learning rather than me doing all the work for you, I have not completed it exactly as requested. Instead, it compiles the schedule into a text string and returns the string. Through modification of the function itself, you could very easily return a two-dimensional array where the first dimension represents the day and the second dimension represents each period?s status.


The module included should provide with you with a solid foundation you can build on. All of the hardest parts are completed with some explanations in the commenting. If you need any additional help, let me know and I?ll see what I can do.

Scott

[vba]
Option Base 1
Option Explicit

'************************************************************************** ***************
'** Author: Scott Dennison **
'** Date: 09/25/2008 **
'** NOTES: **
'** With the creation of a networked work environment, many thing shave become **
'** easier, including the scheduling of the business workday. But Microsoft doesn't **
'** appear to have a good way to relay this information from the Calendar to other **
'** people via E-Mail. **
'** **
'** When properly connected to an Exchange Server, Microsoft Outlook has a function **
'** which will return a numeric value representing the availability status of a **
'** Recipient for a user-defined period. This data is returned based on an initial **
'** date and populates for the month following. **
'** **
'** The FreeBusy function returns a string concatenation where each digit **
'** represents one period of the schedule, starting at midnight. For instance, if **
'** you pass the argument FreeBusy(Now(), 60, True), you are requesting the **
'** information the information for a month on an hourly basis. The result will **
'** return 720 periods, each with a value of 1-4. The numeric values represent: **
'** olFree = 0 **
'** olTentative = 1 **
'** olBusy = 2 **
'** olOutOfOffice = 3 **
'************************************************************************** ***************

Public Sub Test()
GetFreeBusyInfo #9/25/2008#, #9/30/2008#, "06:00", "15:00", 60
End Sub

' This function returns a formatted text string representing the date, time for each period
' and the status of the Recipient during that period.
Public Function GetFreeBusyInfo(StartDate As Date, EndDate As Date, _
StartOfDay As Date, EndOfDay As Date, _
IntervalPeriod As Integer) As String
' We define our variables for accessing the Default Calendar.
Dim nspCurrentSession As NameSpace
Dim rcpRecipient As Recipient

' We set the Current Session equal to the default namespace for Outlook.
Set nspCurrentSession = Application.GetNamespace("MAPI")
' If you are attempting to get the FreeBusy schedule for someone else, you
' may be able to access it by specifying the Recipient.
Set rcpRecipient = nspCurrentSession.CreateRecipient("Jolly Roger")

' We define a standard string for storing the values that the Calendar's FreeBusy function
' will return.
Dim strFreeBusyData As String

' Now lets get the raw data from the calendar.
strFreeBusyData = rcpRecipient.FreeBusy(Now(), IntervalPeriod, True)

' Now we have the raw data, we must interpret it. The FreeBusy function returns a string
' concatenation where each digit represents one period of the schedule, starting at
' midnight. For instance, if you pass the argument FreeBusy(Now(), 60, True), you
' are requesting the information the information for a month on an hourly basis. The
' result will return 720 periods, each with a value of 1-4. The numeric values represent:
' olFree = 0
' olTentative = 1
' olBusy = 2
' olOutOfOffice = 3

Dim datDuration As Date
Dim intDuration As Integer
Dim intDeadIntervals As Integer
Dim intIntervals As Integer

' Since we have so much data, we want to break it up into managable pieces. We will start
' by breaking the month's data into daily segments and store only the dates that we want
' to keep in an array. The rest of the data will be discarded.
Dim strRawDaily() As String

' We need to re-dimension the array to store the correct number of days based on the
' arguments passed to the function.
Dim intDay As Integer
Dim intDays As Integer
intDays = DateDiff("d", StartDate, EndDate) + 1

ReDim strRawDaily(intDays)

' We start by determining how many periods there are per day. This is easily calculated
' by taking the Hours in a Day (24), multiplying it by the Minutes in an Hour (60), and
' and dividing it by the IntervalPeriod.
Dim intIntervalsPerDay As Integer
intIntervalsPerDay = 24 * 60 / IntervalPeriod

For intDay = 1 To intDays
strRawDaily(intDay) = Mid(strFreeBusyData, intIntervalsPerDay * (intDay - 1) + 1, intIntervalsPerDay)
Next intDay

' First, we need to know how many intervals we will ignore at the
' start of the return string. Since you want to know the Free
' periods during the work day, we will ignore the time period
' between midnight and StartOfDay.
datDuration = StartOfDay
intDuration = Hour(datDuration) * 60 + Minute(datDuration)
intDeadIntervals = intDuration / IntervalPeriod

' Now, we need to know how many intervals we will evaluate for
' the workday. This is specified using the StartOfDay and
' EndOfDay arguments.
datDuration = EndOfDay - StartOfDay
intDuration = Hour(datDuration) * 60 + Minute(datDuration)
intIntervals = intDuration / IntervalPeriod

Dim strSchedule As String
Dim intInterval As Integer

For intDay = LBound(strRawDaily) To UBound(strRawDaily)
' Now let's create a schedule using the defined work periods and intervals.
strSchedule = strSchedule & Format(StartDate + Day(intDay) - Day(1), "mm/dd/yyyy")
' Depending on the purpose of the program, you can process the data prior to the
' start of the workday here. Since we only want work hours, we leave this area
' empty.
For intInterval = 0 To intDeadIntervals - 1
' Debug.Print Format(DateAdd("n", intInterval * IntervalPeriod, Date), "HH:mm") & _
' " - Dead Time"
Next intInterval

' Now, we want to process the data for the workday. This is done below and utilizes
' a Select Case statement to determine the status of each interval.
For intInterval = intInterval To intDeadIntervals + intIntervals - 1
strSchedule = strSchedule + vbCrLf & vbTab & _
Format(DateAdd("n", intInterval * IntervalPeriod, Date), "HH:mm")
Select Case Mid(strRawDaily(intDay), intInterval, 1)
Case olFree
strSchedule = strSchedule & " - Free"
Case olTentative
strSchedule = strSchedule & " - Tentative"
Case olBusy
strSchedule = strSchedule & " - Busy"
Case olOutOfOffice
strSchedule = strSchedule & " - Out of Office"
End Select
Next intInterval
strSchedule = strSchedule & vbCrLf
Next intDay

' Now that we have a formatted schedule, return the schedule to the user.
GetFreeBusyInfo = strSchedule
End Function
[/vba]