Solved

Need to add appointment to outlook shared calendar from access

Posted on 2015-02-01
8
119 Views
Last Modified: 2015-07-06
I need to be able to pull up the shared calendars and then choose one to add the appointment to.
Here is what i am working with:
Dim outobj As Outlook.Application
            Dim outappt As Outlook.AppointmentItem
            Set outobj = CreateObject("outlook.application")
            Set outappt = outobj.CreateItem(olAppointmentItem)
            With outappt
               .Start = Me!ApptDate & " " & Me!ApptTime
               .Duration = Me!ApptLength
               .Subject = Me!Appt
               If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes
               If Not IsNull(Me!ApptLocation) Then .Location = _
                  Me!ApptLocation
               If Me!ApptReminder Then
                  .ReminderMinutesBeforeStart = Me!ReminderMinutes
                  .ReminderSet = True
               End If
               .Save
            End With
0
Comment
Question by:VGuerra67
  • 5
  • 3
8 Comments
 
LVL 18

Accepted Solution

by:
Simon earned 500 total points
ID: 40582816
You need the Namespace.Pickfolder method for this

I don't have it in front of me but have working code for this...

First get the MAPI namespace for your Outlook application object.

The use its pickfolder method to return an object variable to the folder you want, which can be in the user's mailbox or any shared mailbox that they have access to.
0
 

Author Comment

by:VGuerra67
ID: 40584163
Thanks for the update if you have some code that would be great
0
 
LVL 18

Expert Comment

by:Simon
ID: 40584277
Ok, here is some code. To use it, paste it into a new module in your Access database, and add a reference to the Microsoft Outlook object library (VBE/Tools/References).
It uses a lookup to get the mailbox EntryID from a lookup table based on the mailbox email address, and if it can't find one, it prompts the user to pick a folder. If it has to prompt for a folder it write the EntryID of the folder you chose to the immediate window so you can copy it to a lookup table to avoid being prompted each time.

Option Compare Database
Option Explicit

Sub test_Createappointment()
Dim retVal As String
retVal = CreatePublicCalendarAppt("GenericBox.test@domain.net", #1/17/2015 12:00:00 PM#, #1/18/2015 1:45:00 PM#, "Title", "Loc", "Text ")
Debug.Print retVal
End Sub

Function CreatePublicCalendarAppt(CalendarName As String, apptStartDate As Date, apptEndDate As Date, _
apptTitle As String, apptLocation As String, apptBody As Variant, Optional isAllDayEvent As Variant)
    Dim objApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim objDummy As Outlook.MailItem
    Dim objRecip As Outlook.Recipient
    Dim objAppt As Outlook.AppointmentItem
    Dim strMsg As String
    Dim strName As String
    Dim GUID As String 'Unique ID of the item created
    Dim folderID As Variant 'Unique ID of the folder object in the mail store

    strName = CalendarName
    
    If IsMissing(isAllDayEvent) Then
        isAllDayEvent = False
    Else
        isAllDayEvent = CBool(isAllDayEvent)
    End If
    
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objDummy = objApp.CreateItem(olMailItem)
    Set objRecip = objDummy.Recipients.Add(strName)
    objRecip.Resolve
    If objRecip.Resolved Then
        folderID = DLookup("strValue", "tblConfigValues", "ConfigGroup='SharedCalendarNames' AND strLabel='" & strName & " EntryID'")
        If Not IsNull(folderID) Then
            Set objFolder = objNS.GetFolderFromID(folderID)
        End If

        '*********************
        'Use line below to pick the folder then get its EntryID. Can then set reference to it.
        If objFolder Is Nothing Then
        Set objFolder = _
          objNS.PickFolder
          If Not objFolder Is Nothing Then
            Debug.Print "Picked folder: EntryID = " & objFolder.EntryID 'Store this in a lookup table to avoid being prompted to pick a folder each time
            Debug.Print "Picked folder: FolderPath = " & objFolder.folderPath
        Else
            Debug.Print "No Folder picked"
            CreatePublicCalendarAppt = ""
            Exit Function
          End If
        End If
        '*********************

On Error GoTo 0
        
        If Not objFolder Is Nothing Then
            Set objAppt = objFolder.items.Add
            If Not objAppt Is Nothing Then
                With objAppt
                    .Subject = apptTitle
                    .Location = apptLocation
                    .Body = apptBody
                    .AllDayEvent = isAllDayEvent
                    .Start = apptStartDate
                    'Don't add end or it cannot be saved as allday event!!!
                    If Not isAllDayEvent Then
                        .End = apptEndDate
                    End If
                    'Add custom property to store GlobalAppointmentID as text string (as opposed to binary)
                    .ItemProperties.Add "GAI", olText, True
                    .save
                    GUID = .GlobalAppointmentID
                    .ItemProperties.Item("GAI").Value = GUID
                    .save
                    '.Display
                End With
            End If
        Else
            If objRecip Is Nothing Then
                MsgBox "Could not get calendar for " & strName ' VM 2012-09-12 Added to cater for objRecip is Nothing
            Else
                MsgBox "Could not get calendar for " & objRecip.Name ' VM if outlook unable to open, Error 91 Object variable or With block variable not set
            End If
        End If
    Else
        MsgBox "Could not find " & Chr(34) & strName & Chr(34), , _
               "CreatePublicCalendarAppt: User or object not found"
    End If

    Set objApp = Nothing
    Set objNS = Nothing
    Set objFolder = Nothing
    Set objDummy = Nothing
    Set objRecip = Nothing
    Set objAppt = Nothing
    
    CreatePublicCalendarAppt = GUID
End Function

Open in new window

0
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 

Author Comment

by:VGuerra67
ID: 40585225
After I copied and pasted your code.  I am getting an error message for "tblconfigvalues". What should be in this table?
0
 
LVL 18

Expert Comment

by:Simon
ID: 40585236
Please comment out lines 37 to 40 of the code in the listing above for the moment.
ie. These ones....
        folderID = DLookup("strValue", "tblConfigValues", "ConfigGroup='SharedCalendarNames' AND strLabel='" & strName & " EntryID'")
        If Not IsNull(folderID) Then
            Set objFolder = objNS.GetFolderFromID(folderID)
        End If

Open in new window


I can provide the table definition tomorrow, but for testing purposes you can comment that out and it will then prompt you to pick the calendar folder to add the apppointment to.

The configtable allows you to store the EntryID for calendars you work with regularly to save you having to pick the folder from the PickFolder dialog.
0
 
LVL 18

Expert Comment

by:Simon
ID: 40586002
Here's a sample of the config table entry that I use
tblConfigValues.pngThe first time you run this you need to step through the code and view the immediate window to get the ENTRYID for your shared calendar. You can then save that to a config table and look it up during subsequent runs.
0
 

Author Comment

by:VGuerra67
ID: 40590387
I am not sure what i am doing wrong.  However, i still can only get to my calender when the piicked folder option comes up.
The calendars that i am trying to put the appointments in are shared calendars they are not public.  I don't know if that makes a difference.
My objective is to create an access 2013 event that will populate an appointment in an outlook shared calendar.   I would like to be able to select which calendar in the event that i have multiple to choose from
0
 
LVL 18

Expert Comment

by:Simon
ID: 40590523
Have you copied the value for EntryID and inserted it into the tblConfigValues?

When you call the function you should pass the generic account's email address as the first param
retVal = CreatePublicCalendarAppt("GenericBox.test@domain.net",

Open in new window


These lines are where your saved EntryID is looked up and used to set a reference to the folder, using the GetFolderFromID method.
    If objRecip.Resolved Then
        folderID = DLookup("strValue", "tblConfigValues", "ConfigGroup='SharedCalendarNames' AND strLabel='" & strName & " EntryID'")
        If Not IsNull(folderID) Then
            Set objFolder = objNS.GetFolderFromID(folderID)
        End If

Open in new window

0

Featured Post

Simplifying Server Workload Migrations

This use case outlines the migration challenges that organizations face and how the Acronis AnyData Engine supports physical-to-physical (P2P), physical-to-virtual (P2V), virtual to physical (V2P), and cross-virtual (V2V) migration scenarios to address these challenges.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

790 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question