Solved: Finding empty days in the Calendar

[globetrot]

Hello All,

As the title suggests, I am after some code that will find all the days in a particular month in the Calendar that have no appointments on them and then report the dates of those days in an email I can send.

Regards
Brenton

[Killian]

Hi Brenton,

While it's easy enough to loop through all the appointment items, looping through the days isn't quite so straight forward.
One way I've found is to loop though a range of integers (in my example 0 to 30) relative to Now (the vba function for the current day) and use Outlooks Find method applied to the appointments object for each day and see if it's empty.

A bit contrived but it seems to work. If you want to specify the date range to check, you'll just need to manipulate the loop index (d) and the Find filter (sFilter)[VBA]Sub FindFreeDays()

Dim myNameSpace As NameSpace
Dim myAppointments As Items
Dim currentAppointment As AppointmentItem
Dim myMail As MailItem
Dim d As Integer
Dim sFilter As String
Dim strBody As String

Set myNameSpace = GetNamespace("MAPI")
Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items

Set myMail = CreateItem(olMailItem)
strBody = "Free dates:" & vbLf
For d = 0 To 30
sFilter = "[Start] >= '" & Format(Now + d, "Short Date") & "' and [Start] <= '" & Format(Now + d + 1, "Short Date") & "'"
Set currentAppointment = myAppointments.Find(sFilter)
If currentAppointment Is Nothing Then
strBody = strBody & Format(Now + d, "Short Date") & vbLf
End If
Next
myMail.Body = strBody
myMail.Display

Set myMail = Nothing
Set myAppointments = Nothing
Set myNameSpace = Nothing

End Sub[/VBA]

[MOS MASTER]

Hi Killian and Brenton,

This is a nice question!

Love this code K, very nifty!

[Killian]

Thnx

It seemed strange that there's no room in the object model for days/weeks/months as items in the calender folder !?

[MOS MASTER]

Hi K,

True it does seam strange but I could build you a list long enough with stuff I'd like to add to the objectmodel of each app and to the office model itself!

Somehow I feel MS has done some apps short in there VBA resources and I do wonder what futer has in store for us now that support has been cancelled for VB althogether. (Seams there will be a .NET version of Office to come and do wonder what the succesor of VBA will look like...perhaps (VBA.NET))

[globetrot]

Thanks for the input, love the code but how do you exlude the weekends? Also would the restrict method work? And finally one other thing and this may sound stupid, but I can't find a way to put macro buttons on the Outlook toolbars, I have tried the method as you would use it Excel or Word, but it doesnt seem to be there! Any ideas? Thanks

[MOS MASTER]

Hi,

This modification will exclude weekends:[VBA]
Sub FindFreeDays()
Dim myNameSpace As NameSpace
Dim myAppointments As Items
Dim currentAppointment As AppointmentItem
Dim myMail As MailItem
Dim d As Integer
Dim sFilter As String
Dim strBody As String
Dim dDate As Date

Set myNameSpace = GetNamespace("MAPI")
Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items

Set myMail = CreateItem(olMailItem)
strBody = "Free dates:" & vbLf
For d = 0 To 30
sFilter = "[Start] >= '" & Format(Now + d, "Short Date") & "' and [Start] <= '" & Format(Now + d + 1, "Short Date") & "'"
Set currentAppointment = myAppointments.Find(sFilter)
If currentAppointment Is Nothing Then
dDate = CDate(Now() + d)
Select Case Weekday(dDate)
Case vbSaturday, vbSunday
'A weekend 1 for Sunday ...7 for Saturday
Case Else
strBody = strBody & Format(Now + d, "Short Date") & vbLf
End Select
End If
Next
myMail.Body = strBody
myMail.Display

Set myMail = Nothing
Set myAppointments = Nothing
Set myNameSpace = Nothing

End Sub
[/VBA]

Enjoy!

[globetrot]

Thanks for the code that works fine, however I didnt get an answer about the Outlook toolbars, any ideas?