[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