Non Default Outlook Calendar

Discussion in 'Access VBA Modules' started by Tom, Dec 3, 2013.

  1. Tom

    Tom Guest

    I have the code below which creates an appointment in Outlook default calendar. I need to add a few lines to create the appointment to an alternative calendar in the same pst file. I need to choose between three calendars in which to create the appointment and plan to select the calendar name from alist on the form.
    Any help welcome.

    Dim objOutlook As Outlook.Application
    Dim objAppt As Outlook.AppointmentItem
    Set objOutlook = CreateObject("Outlook.Application")
    Set objAppt = objOutlook.CreateItem(olAppointmentItem)

    With objAppt
    ..Start = Me!ApptDate & " " & Me!ApptTime
    ..Duration = Me!ApptLength
    ..Subject = Me!Appt

    .Save
    .Close (olSave)
    End With

    Set objAppt = Nothing
    Set objOutlook = Nothing
     
    Tom, Dec 3, 2013
    #1
    1. Advertisements

  2. Tom

    Patrick Wood Guest

    One way to do this is to use the PickFolder Method as the code below demonstrates. The code opens an Outlook Dialog allowing you to "Pick" the folder you want. The code verifies the Folder selected is a Calendar Folder.

    Sub SaveAppointmentInFolder()

    Dim objOutlook As Outlook.Application
    Dim objAppt As Outlook.AppointmentItem
    Dim objNameSpace As Outlook.NameSpace
    Dim objFolder As Outlook.Folder

    On Error GoTo ErrHandle

    Set objOutlook = CreateObject("Outlook.Application")

    'Instantiate the MAPI Namespace needed to get a Folder.
    Set objNameSpace = objOutlook.GetNamespace("MAPI")

    'A Label is used here to return here if wrong type of Folder is
    'selected enabling the user to select the correct type of folder.
    SelectFolder:
    'Use PickFolder Method to select the Folder needed.
    Set objFolder = objNameSpace.PickFolder

    'Make sure a Folder has been chosen.
    If objFolder Is Nothing Then
    MsgBox "A Folder was not selected." & vbCrLf _
    & vbCrLf & "Please try again and select a Calendar Folder.", vbExclamation
    GoTo ExitHere
    Else
    'Verify this is a Calendar folder.
    If objFolder.DefaultItemType <> olAppointmentItem Then
    MsgBox "Please select a Calendar Folder."
    GoTo SelectFolder
    End If
    End If

    ' Create a new Appointment in the selected folder
    Set objAppt = objFolder.Items.Add

    With objAppt
    .Start = Me!ApptDate & " " & Me!ApptTime
    .Duration = Me.txtApptLength
    .Subject = Me.cboApptDescription
    .Save
    .Close (olSave)
    End With

    ExitHere:
    On Error Resume Next
    Set objFolder = Nothing
    Set objNameSpace = Nothing
    Set objAppt = Nothing
    Set objOutlook = Nothing
    Exit Sub

    ErrHandle:
    MsgBox "Error #" & Err.Number & " " & Err.Description _
    & vbCrLf & " In Procedure SaveAppointmentInFolder"
    Resume ExitHere

    End Sub


    On Tuesday, December 3, 2013 7:31:36 AM UTC-5, Tom wrote:
    > I have the code below which creates an appointment in Outlook default calendar. I need to add a few lines to create the appointment to an alternative calendar in the same pst file. I need to choose between three calendars in which to create the appointment and plan to select the calendar name froma list on the form.
    >
    > Any help welcome.
    >
    >
    >
    > Dim objOutlook As Outlook.Application
    >
    > Dim objAppt As Outlook.AppointmentItem
    >
    > Set objOutlook = CreateObject("Outlook.Application")
    >
    > Set objAppt = objOutlook.CreateItem(olAppointmentItem)
    >
    >
    >
    > With objAppt
    >
    > .Start = Me!ApptDate & " " & Me!ApptTime
    >
    > .Duration = Me!ApptLength
    >
    > .Subject = Me!Appt
    >
    >
    >
    > .Save
    >
    > .Close (olSave)
    >
    > End With
    >
    >
    >
    > Set objAppt = Nothing
    >
    > Set objOutlook = Nothing
     
    Patrick Wood, Feb 15, 2014
    #2
    1. Advertisements

  3. Tom

    Patrick Wood Guest

    One way to do this is to use the PickFolder Method as the code below demonstrates. The code opens an Outlook Dialog allowing you to "Pick" the folder you want. The code verifies the Folder selected is a Calendar Folder.

    Sub SaveAppointmentInFolder()

    Dim objOutlook As Outlook.Application
    Dim objAppt As Outlook.AppointmentItem
    Dim objNameSpace As Outlook.NameSpace
    Dim objFolder As Outlook.Folder

    On Error GoTo ErrHandle

    Set objOutlook = CreateObject("Outlook.Application")

    'Instantiate the MAPI Namespace needed to get a Folder.
    Set objNameSpace = objOutlook.GetNamespace("MAPI")

    'Use label here to return here if wrong type of Folder is selected.
    SelectFolder:
    'Use PickFolder Method to select the Folder needed.
    Set objFolder = objNameSpace.PickFolder

    'Make sure a Folder has been chosen.
    If objFolder Is Nothing Then
    MsgBox "A Folder was not selected." & vbCrLf _
    & vbCrLf & "Please try again and select a Calendar Folder.", vbExclamation
    GoTo ExitHere
    Else
    'Verify this is a Calendar folder.
    If objFolder.DefaultItemType <> olAppointmentItem Then
    MsgBox "Please select a Calendar Folder."
    GoTo SelectFolder
    End If
    End If

    ' Create a new Appointment in the selected folder
    Set objAppt = objFolder.Items.Add

    With objAppt
    .Start = Me!ApptDate & " " & Me!ApptTime
    .Duration = Me!ApptLength
    .Subject = Me!Appt
    .Save
    .Close (olSave)
    End With

    ExitHere:
    On Error Resume Next
    Set objFolder = Nothing
    Set objNameSpace = Nothing
    Set objAppt = Nothing
    Set objOutlook = Nothing
    Exit Sub

    ErrHandle:
    MsgBox "Error #" & Err.Number & " " & Err.Description _
    & vbCrLf & " In Procedure SaveAppointmentInFolder"
    Resume ExitHere

    End Sub


    On Tuesday, December 3, 2013 7:31:36 AM UTC-5, Tom wrote:
    > I have the code below which creates an appointment in Outlook default calendar. I need to add a few lines to create the appointment to an alternative calendar in the same pst file. I need to choose between three calendars in which to create the appointment and plan to select the calendar name froma list on the form.
    >
    > Any help welcome.
    >
    >
    >
    > Dim objOutlook As Outlook.Application
    >
    > Dim objAppt As Outlook.AppointmentItem
    >
    > Set objOutlook = CreateObject("Outlook.Application")
    >
    > Set objAppt = objOutlook.CreateItem(olAppointmentItem)
    >
    >
    >
    > With objAppt
    >
    > .Start = Me!ApptDate & " " & Me!ApptTime
    >
    > .Duration = Me!ApptLength
    >
    > .Subject = Me!Appt
    >
    >
    >
    > .Save
    >
    > .Close (olSave)
    >
    > End With
    >
    >
    >
    > Set objAppt = Nothing
    >
    > Set objOutlook = Nothing
     
    Patrick Wood, Feb 15, 2014
    #3
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.