B
brotherescott
I got this code from www.dicks-clicks.com web page and it works great
but it does not pick up meetings that were setup as reoccuring. For
some reason it skips them. How can I test for all apointments on a
specific day not matter what type the are?
I send the date to this sub from another.
Sub GetAppt(NeedDate As Date)
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim olFldr As MAPIFolder
Dim olApt As AppointmentItem
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderCalendar)
For Each olApt In olFldr.Items
If Format(olApt.Start, "m/d/yyyy") = NeedDate Then
'Put the appointment subject text into the active cell
If ActiveCell = "" Then
ActiveCell = olApt.Subject
Else 'This will add a new line and the subject text of the
next appoitment
ActiveCell = ActiveCell & Chr(10) & olApt.Subject
End If
End If
Next olApt
Set olApt = Nothing
Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Thanks
Scott
but it does not pick up meetings that were setup as reoccuring. For
some reason it skips them. How can I test for all apointments on a
specific day not matter what type the are?
I send the date to this sub from another.
Sub GetAppt(NeedDate As Date)
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim olFldr As MAPIFolder
Dim olApt As AppointmentItem
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderCalendar)
For Each olApt In olFldr.Items
If Format(olApt.Start, "m/d/yyyy") = NeedDate Then
'Put the appointment subject text into the active cell
If ActiveCell = "" Then
ActiveCell = olApt.Subject
Else 'This will add a new line and the subject text of the
next appoitment
ActiveCell = ActiveCell & Chr(10) & olApt.Subject
End If
End If
Next olApt
Set olApt = Nothing
Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Thanks
Scott