Solved

Need to add appointment to outlook shared calendar from access

Posted on 2015-02-01
8
114 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:
SimonAdept 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:SimonAdept
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
 

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
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 
LVL 18

Expert Comment

by:SimonAdept
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:SimonAdept
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:SimonAdept
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
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…
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

707 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now