PDA

View Full Version : Solved: Finding empty days in the Calendar



globetrot
05-12-2005, 05:45 PM
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
05-13-2005, 03:58 AM
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)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

MOS MASTER
05-13-2005, 11:25 AM
Hi Killian and Brenton, :D

This is a nice question!

Love this code K, very nifty! :yes

Killian
05-13-2005, 07:00 PM
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
05-14-2005, 09:48 AM
Hi K, :yes

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)) :rofl:

globetrot
05-21-2005, 06:00 PM
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
05-24-2005, 01:44 PM
Hi, :yes

This modification will exclude weekends:
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


Enjoy! :whistle:

globetrot
06-16-2005, 05:50 PM
Thanks for the code that works fine, however I didnt get an answer about the Outlook toolbars, any ideas?

Marcster
06-17-2005, 04:35 AM
Hi globetrot, try this (tested on Outlook 2000):

Click on Tools > Customize
On the Toolbars tab click the New.. button
Name the toolbar
Click on the Commands tab
Under the Categories select Macros
Under the Commands drag the macro to your new toolbar
Close the Customize dialog
Drag your nerw toolbar upto the menu bar

Is this what you was after?. Or was you after code to be able to do this?.

globetrot
06-17-2005, 09:05 PM
Sorry guys, I am referring to toolbars in Publisher not Outlook, my mistake!

MOS MASTER
06-18-2005, 11:03 AM
Thanks for the code that works fine, however I didnt get an answer about the Outlook toolbars, any ideas?
You're most welcome and I've missed the question on the toolbars. :whistle:

MOS MASTER
06-18-2005, 11:04 AM
Sorry guys, I am referring to toolbars in Publisher not Outlook, my mistake!
No problem, what version of publisher are you using? I only have 2003 to test..

MOS MASTER
06-19-2005, 01:12 PM
Sorry guys, I am referring to toolbars in Publisher not Outlook, my mistake!
Hi Globe, :yes

Don't know your version but made you an example anyway! (Set macro security to Medium first!)

The code past in ThisDocument class module:
Option Explicit
Private Sub Document_Open()
RemoveButton
AddButton
End Sub

Private Sub RemoveButton()
On Error Resume Next
Application.CommandBars("Standard").Controls("A New Button").Delete
Err.Clear
End Sub

Private Sub AddButton()
Dim oBar As Office.CommandBar
Dim oButton As Office.CommandBarButton

Set oBar = Application.CommandBars("Standard")
Set oButton = oBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)

With oButton
.Caption = "A New Button"
.FaceId = 1000
.Style = msoButtonIconAndCaption
.OnAction = "Hello"
End With

Set oButton = Nothing
Set oBar = Nothing
End Sub

Private Sub Hello()
MsgBox "Hi How are you"
End Sub


This will create the button when the document is opened. (See Attachment)

Enjoy! :whistle:

globetrot
08-01-2005, 06:00 AM
That code works fine, but I am curious as to why Publisher does not have the standard method for inserting buttons on toolbars, i.e. Customise. Does anyone know why?

MOS MASTER
08-01-2005, 09:50 AM
That code works fine, but I am curious as to why Publisher does not have the standard method for inserting buttons on toolbars, i.e. Customise. Does anyone know why?

You're welcome! :yes

The answer to your question is easy IMO.

Each single app is developt by a different team at Microsoft. Yes they do some group planning but there are a lot of minor differences between the Office Apps. (This is a big one btw) and this is just one of those differences.

HTH, :whistle: