Adding Outlook Calendar item to a Public Folder from Access 2010

Question

I am trying to add a calendar appointment from Access 2010 to an Outlook public calendar. I have found several ways to do this, but can't seem to get it to work with my code. One thing that may be the problem is that I don't understand what the code is doing when it's setting up the folder to save to. Here is my code that save to my Outlook calendar. How do I get it to save to a public Outlook calendar called janettest? Please explain code because that's where I think I'm getting confused. Thanks in advance.

Private Sub Command60_Click()

 ' Exit the procedure if appointment has been added to Outlook.
 If Me.chkAddedToOutlook = True Then
     MsgBox "This appointment has already added to Microsoft Outlook.", vbCritical
     Exit Sub
 Else

     ' Use late binding to avoid the "Reference" issue
     Dim olApp As Object        'Outlook.Application
     Dim olAppt As Object        'olAppointmentItem
     Dim dteTempEnd As Date
     Dim dteStartDate As Date
     Dim dteEndDate As Date

     If isAppThere("Outlook.Application") = False Then
         ' Outlook is not open, create a new instance
         Set olApp = CreateObject("Outlook.Application")
         Else
         ' Outlook is already open--use this method
         Set olApp = GetObject(, "Outlook.Application")

     End If

    Set olAppt = olApp.CreateItem(1) ' 1 = olAppointmentItem

    With olAppt

         If Nz(Me.AllDay_YesNo) = True Then

             .Alldayevent = True

             ' Get the Start and the End Dates
             dteStartDate = CDate(FormatDateTime(Me.TxtBeginDate, vbShortDate)) ' Begining Date 
             dteTempEnd = CDate(FormatDateTime(Me.txtEndDate, vbShortDate))      ' End Date   
             ' Add one day to dteEndDate so Outlook will set the number of days correctly
             dteEndDate = DateSerial(Year(dteTempEnd + 1), Month(dteTempEnd + 1), Day(dteTempEnd + 1))

             .Start = dteStartDate
             .End = dteEndDate

         Else

             .Alldayevent = False

             If (Me.TxtBeginDate = Me.txtEndDate) Then

                ' Set the Start Property Value
                .Start = CDate(FormatDateTime(Me.TxtBeginDate, vbShortDate) _
                    & " " & FormatDateTime(Me.txtStartTime, vbShortTime))

                ' Set the End Property Value
                .End = CDate(FormatDateTime(Me.txtEndDate, vbShortDate) _
                     & " " & FormatDateTime(Me.txtEndTime, vbShortTime))

             Else

                ' Get the Start and the End Dates
                dteStartDate = CDate(FormatDateTime(Me.TxtBeginDate, vbShortDate))      
                dteEndDate = CDate(FormatDateTime(Me.txtEndDate, vbShortDate))     

                ' Add one day to dteEndDate so Outlook will set the number of days correctly
                .Start = dteStartDate
                .End = dteEndDate + 1

             End If
         End If

         If Len(Me.Employee & vbNullString) > 0 Then
            Dim vname, vname2, vdesc As String
            vname = DLookup("FirstName", "tblEmployees", "EmployeeID =  " & Me.Employee)
            vname2 = DLookup("LastName", "tblEmployees", "EmployeeID =  " & Me.Employee)
            vdesc = DLookup("Description", "tblCodesWork", "WorkCodeID  = " & Me.WorkCode)
             .Subject = vname & " " & vname2 & " - " & vdesc

         End If

         ' Save the Appointment Item Properties
         .Save

     End With

     ' Set chkAddedToOutlook to checked
     Me.chkAddedToOutlook = True

     ' Inform the user
     MsgBox "New Outlook Appointment Has Been Added!", vbInformation
 End If

ExitHere: ' Release Memory Set olAppt = Nothing Set olApp = Nothing Exit Sub

ErrHandle: MsgBox "Error " & Err.Number & vbCrLf & Err.Description _ & vbCrLf & "In procedure btnAddApptToOutlook_Click in Module Module1" Resume ExitHere

End Sub

user3033348 user3033348 · Accepted Answer · 2014-03-28T15:21:35

I found a site that explains this to me. It's:

http://blogs.technet.com/b/heyscriptingguy/archive/2006/08/03/how-can-i-get-access-to-a-mail-folder-that-isn-t-a-subfolder-of-my-outlook-inbox.aspx

Adding Outlook Calendar item to a Public Folder from Access 2010

1 Answers