Solved

Need to add appointment to outlook shared calendar from access

Posted on 2015-02-01
8
118 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
Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

 

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

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

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

When you are entering numbers in a speadsheet, and don't remember what 6×7 is, you just type “=6*7" instead. It works in every cell! This is not so in Access. To enter the elusive 42 in a text box, you have to find a calculator, and then copy the re…
Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Familiarize people with the process of utilizing SQL Server functions 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 Ac…

816 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

10 Experts available now in Live!

Get 1:1 Help Now