Max Wanadoo
max.wanadoo at gmail.com
Fri Mar 12 04:33:35 CST 2010
Rocky, you could try the code below. Remember this is Outlook and not
Exchange Server but it might do the trick.
Max
Private Sub sCalendar()
Dim ol As Outlook.Application
Dim onMAPI As NameSpace
'Dim ofMyOutlook As MAPIFolder
Dim ofFolder As MAPIFolder
Dim ofCalendar As MAPIFolder
Dim myCalendar As MAPIFolder
Dim myItem As Object
Dim strCalendarName As String
Dim myRequiredAttendee As Outlook.Recipient
Dim myoptionalAttendee As Outlook.Recipient
Dim myResourceAttendee As Outlook.Recipient
Dim ifor As Integer
Set ol = New Outlook.Application
Set onMAPI = ol.GetNamespace("MAPI")
'On Error Resume Next
'Debug.Print onMAPI.Class
'Debug.Print onMAPI.CurrentUser ' might be useful to get this then you
can personlise your responses to him
' eg.Hey Rocky,your appointment has been made - next time use your
cellphone.
'Debug.Print onMAPI.GetDefaultFolder(olFolderCalendar)
Set ofCalendar = onMAPI.GetDefaultFolder(olFolderCalendar)
For Each ofFolder In ofCalendar.Folders
' this assumes there is only ONE sub calendar but if there are more
than one,
' you will need to pop them up and ask which one or define it in
some way.
strCalendarName = ofFolder.Name: Debug.Print ofFolder.Name
Next ofFolder
Set myCalendar = ofCalendar.Folders(strCalendarName) ' this is the
FOUND name
With myCalendar
Set myItem = myCalendar.Items.Add '
ol.CreateItem(olAppointmentItem)
With myItem
.MeetingStatus = olMeeting
.Subject = "Meeting Tomorrow BoardRoom - test from Max at
AccessD"
.Location = "Conference Room No. 33"
.Start = #3/13/2010 11:30:00 AM# ' month/day/year - change
as required.
.Duration = 90
'
Set myRequiredAttendee =
myItem.Recipients.Add("rockysmolin at bchacc.com")
myRequiredAttendee.Type = olRequired
' Set myoptionalAttendee =
myItem.Recipients.Add("rockysmolin at bchacc.com")
' myoptionalAttendee.Type = olOptional
' Set myResourceAttendee =
myItem.Recipients.Add("rockysmolin at bchacc.com")
' myResourceAttendee.Type = olResource
.Display
'myItem.Send
End With
End With
End Sub
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Rocky Smolin
Sent: Friday, March 12, 2010 5:04 AM
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] Picking Alternate Calendar
So it turns out that in the client's Exchange the top level folder is
"Mailbox - Jack Stone", not 'Personal Folders'. I suppose that any user
could change the name of their top level folder. Do you know if there is a
way to find out the name of that top level folder without prompting the user
for it?
TIA
Rocky
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Max Wanadoo
Sent: Wednesday, March 10, 2010 1:49 AM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Picking Alternate Calendar
Rocky:
Try this code below
Max
Private Sub sDeleteCalEvents()
Dim strDateFrom As String, strDateTo As String
strDateFrom = "01/01/2010" ' mm/dd/yyyy
strDateTo = "12/31/2010" ' mm/dd/yyyy
Dim ol As Outlook.Application
Dim onMAPI As NameSpace
Dim ofMyOutlook As MAPIFolder
Dim ofFolder As MAPIFolder
Dim ofCalendar As MAPIFolder
Dim myItem As Object
Dim myCalendar As Object
Dim strCalendarName As String
' this is the variable which can be passed in as the name of the new
(non-default calendar)
' because it is non-system calendar we cannot use ol.creatitem() but
have to use .items.add
strCalendarName = "My Calendar"
Set ol = New Outlook.Application
Dim ifor As Integer
Set onMAPI = ol.GetNamespace("MAPI")
On Error Resume Next
Set ofMyOutlook = onMAPI.Folders("Personal Folders") ' but I renamed
mine
If Err.Number <> 0 Then
MsgBox "The Outlook 'Personal Folder' cannot be found. Have you
renamed it to something else perhaps?."
Exit Sub
End If
Set ofCalendar = ofMyOutlook.Folders("Calendar") ' this is the
normal name
' go though the folders inside the calendar folder and see if we can
find the user-defined calendar
For ifor = 1 To ofCalendar.Folders.Count
' Debug.Print ofCalendar.Folders(ifor), ifor
If ofCalendar.Folders(ifor) = strCalendarName Then
Set myCalendar = ofCalendar.Folders(ifor) ' Got it
ifor = ofCalendar.Folders.Count ' jump out
End If
Next ifor
Debug.Print myCalendar.Items.Count
For ifor = myCalendar.Items.Count To 1 Step -1 ' work backwards
Debug.Print Format(myCalendar.Items(ifor).Start, "mm/dd/yyyy"), '
trailing comma
If Format(myCalendar.Items(ifor).Start, "mm/dd/yyyy") >= strDateFrom
And Format(myCalendar.Items(ifor).Start, "mm/dd/yyyy") <= strDateTo Then
Debug.Print "Deleted"
myCalendar.Items(ifor).Delete
Else
Debug.Print "Not deleted"
End If
Next ifor
End Sub
Private Sub sCalendar()
Dim ol As Outlook.Application
Dim onMAPI As NameSpace
Dim ofMyOutlook As MAPIFolder
Dim ofFolder As MAPIFolder
Dim ofCalendar As MAPIFolder
Dim myItem As Object
Dim myCalendar As Object
Dim strCalendarName As String
Dim myRequiredAttendee As Outlook.Recipient
Dim myoptionalAttendee As Outlook.Recipient
Dim myResourceAttendee As Outlook.Recipient
' this is the variable which can be passed in as the name of the new
(non-default calendar)
' because it is non-system calendar we cannot use ol.creatitem() but
have to use .items.add
strCalendarName = "My Calendar"
Set ol = New Outlook.Application
Dim ifor As Integer
Set onMAPI = ol.GetNamespace("MAPI")
On Error Resume Next
Set ofMyOutlook = onMAPI.Folders("Personal Folders") ' but I renamed
mine
If Err.Number <> 0 Then
MsgBox "The Outlook 'Personal Folder' cannot be found. Have you
renamed it to something else perhaps?."
Exit Sub
End If
Set ofCalendar = ofMyOutlook.Folders("Calendar") ' this is the
normal name
' go though the folders inside the calendar folder and see if we can
find the user-defined calendar
For ifor = 1 To ofCalendar.Folders.Count
' Debug.Print ofCalendar.Folders(ifor), ifor
If ofCalendar.Folders(ifor) = strCalendarName Then
Set myCalendar = ofCalendar.Folders(ifor) ' Got it
ifor = ofCalendar.Folders.Count ' jump out
End If
Next ifor
If ifor > ofCalendar.Folders.Count + 1 Or ofCalendar.Folders.Count = 0
Then
MsgBox "The user caledar (" & strCalendarName & ") does not appear
as a sub folder of Calendar. Press OK and I will created it for you."
Set ofFolder = onMAPI.GetDefaultFolder(olFolderCalendar)
Set myCalendar = ofFolder.Folders.Add(strCalendarName)
End If
' might need ClickYes installed if you require to send without user
viewing first.
With myCalendar
Set myItem = myCalendar.Items.Add '
ol.CreateItem(olAppointmentItem)
With myItem
.MeetingStatus = olMeeting
.Subject = "Meeting Tomorrow BoardRoom - test from Max at
AccessD"
.Location = "Conference Room No. 33"
.Start = #3/10/2010 2:30:00 PM# ' month/day/year - change as
required.
.Duration = 90
'
Set myRequiredAttendee = myItem.Recipients.Add("
rockysmolin at bchacc.com")
myRequiredAttendee.Type = olRequired
Set myoptionalAttendee = myItem.Recipients.Add("
rockysmolin at bchacc.com")
myoptionalAttendee.Type = olOptional
Set myResourceAttendee = myItem.Recipients.Add("
rockysmolin at bchacc.com")
myResourceAttendee.Type = olResource
'.Display
myItem.Send
End With
End With
End Sub
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com
No virus found in this incoming message.
Checked by AVG - www.avg.com
Version: 9.0.733 / Virus Database: 270.14.129/2605 - Release Date: 03/08/10
23:33:00
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com