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
Printable View
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
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]
Hi Killian and Brenton, :D
This is a nice question!
Love this code K, very nifty! :yes
Thnx
It seemed strange that there's no room in the object model for days/weeks/months as items in the calender folder !?
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:
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
Hi, :yes
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! :whistle:
Thanks for the code that works fine, however I didnt get an answer about the Outlook toolbars, any ideas?
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?.
Sorry guys, I am referring to toolbars in Publisher not Outlook, my mistake!
You're most welcome and I've missed the question on the toolbars. :whistle:Quote:
Originally Posted by globetrot
No problem, what version of publisher are you using? I only have 2003 to test..Quote:
Originally Posted by globetrot
Hi Globe, :yesQuote:
Originally Posted by globetrot
Don't know your version but made you an example anyway! (Set macro security to Medium first!)
The code past in ThisDocument class module:[VBA]
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
[/VBA]
This will create the button when the document is opened. (See Attachment)
Enjoy! :whistle:
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! :yesQuote:
Originally Posted by globetrot
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: