[AccessD] Picking Alternate Calendar

Stuart McLachlan stuart at lexacorp.com.pg
Fri Mar 12 00:55:58 CST 2010


That's standard for Exchange Server.   It's generally Mailbox - User Name.
I don't know if you even *can* change that.

-- 
Stuart

On 11 Mar 2010 at 21:03, Rocky Smolin wrote:

> 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





More information about the AccessD mailing list