SharePoint Calendar in Outlook - how do I select it in Excel - VBA

Posted on 2012-04-13
Medium Priority
Last Modified: 2012-04-17
I have a macro that will add/update outlook calendar items within excel but I need to know how to select the sharepiont calendar. It seems it can't find the object.

In Outlook the calendar is located under the "SharePoint Lists" Folder.

Thank you.

I used code from anther post on this site. (very helpfull)

Public Type aiAppointment
    dtmStart As Date
    booAllDayEvent As Boolean
    lngDuration As Long
    dtmRecurrenceEnds As Date
    lngReminderMinutesBeforeStart As Long
    'dtmEnd As Date
    strSubject As String
    strCategories As String
    strBody As String
    strLocation As String
    strEntryID As String
    strGlobalAppointmentID As String
    booDelete As Boolean
    strFolder As String
End Type
Function OutlookAppointment(appt As aiAppointment)
On Error GoTo AddAppt_Err
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Dim outRecurrPatt As Outlook.RecurrencePattern
Dim outNameSpace As Outlook.Namespace
Dim outFolder As Outlook.Folder
Dim strMSG As String
    Set outobj = CreateObject("outlook.application")
    Set outNameSpace = outobj.GetNamespace("MAPI")
    Set outFolder = outNameSpace.GetDefaultFolder(olFolderCalendar)
    If appt.strFolder <> "" Then
       Set outFolder = outFolder.Folders(appt.strFolder)
    End If
    If appt.strEntryID = "" Then
       Set outappt = outFolder.Items.Add
       ' This is OK for EntryID but cant find the equivalant for GlobalAppointmentID
       Set outappt = outNameSpace.GetItemFromID(appt.strEntryID, outFolder.StoreID)
       'If outappt.GlobalAppointmentID <> Me.txtGlobalAppointmentID Then
       '   MsgBox "The GlobalAppointmentID does not match"
    End If
    With outappt
         If appt.booDelete Then
            If appt.dtmRecurrenceEnds = 0 Then
               .Start = appt.dtmStart
               If appt.booAllDayEvent Then
                  .AllDayEvent = True
                  .AllDayEvent = False
                  .Duration = appt.lngDuration
                  '.End = appt.dtmEnd
               End If
               Set outRecurrPatt = .GetRecurrencePattern
               With outRecurrPatt
                   .RecurrenceType = olRecursDaily
                   .PatternStartDate = DateSerial(Year(appt.dtmStart), Month(appt.dtmStart), Day(appt.dtmStart))
                   .PatternEndDate = DateSerial(Year(appt.dtmRecurrenceEnds), Month(appt.dtmRecurrenceEnds), Day(appt.dtmRecurrenceEnds))
                   .StartTime = TimeSerial(Hour(appt.dtmStart), Minute(appt.dtmStart), Second(appt.dtmStart))
                   If appt.booAllDayEvent Then
                      .Duration = 1440
                      .Duration = appt.lngDuration
                   End If
               End With
            End If
            .Subject = appt.strSubject
            .Categories = appt.strCategories
            .Body = appt.strBody
            .Location = appt.strLocation
            If appt.lngReminderMinutesBeforeStart <= 0 Then
               .ReminderSet = False
               .ReminderSet = True
               .ReminderMinutesBeforeStart = appt.lngReminderMinutesBeforeStart
               .ReminderOverrideDefault = True
               .ReminderPlaySound = True
 '              .ReminderSoundFile = SysCmd(acSysCmdAccessDir) & "Reminder.wav"
            End If
            If Val(.OutlookVersion) >= 12 And appt.strGlobalAppointmentID = "" Then appt.strGlobalAppointmentID = .GlobalAppointmentID
            If appt.strEntryID = "" Then appt.strEntryID = .EntryID
         End If
    End With
    ' Release the Outlook object variable.
    Set outobj = Nothing
    Exit Function
    Select Case Err
        Case Else
             strMSG = "An unexpected error has oocurred in AddAppt" & vbCrLf & vbCrLf & _
                      "Error " & vbTab & "Description" & vbCrLf & _
                      Err.Number & vbTab & Err.Description
             Select Case MsgBox(strMSG, vbCritical + vbAbortRetryIgnore, "Error in AddAppt")
                 Case vbAbort:  Resume AddAppt_Exit
                 Case vbIgnore: Resume Next
                 Case vbRetry:  Resume
             End Select
    End Select
End Function
Sub TestAppointment()
Dim appt As aiAppointment
'Create a new appointment
    With appt
        .dtmStart = Now() + 1
'        .dtmRecurrenceEnds = .dtmStart + 28
        .booAllDayEvent = True
'        .lngDuration = 30
        .lngReminderMinutesBeforeStart = 10
'        .strLocation = "Home"
        .strSubject = "Test Subject"
        .strFolder = "NAEP Background Questionnaire - Calendar"
    End With
    OutlookAppointment appt
    MsgBox "Appointment Created"
' Update the appointment
    With appt
        .strBody = Format(Now(), "dd mmmm yyyy hh:nn") & " Test Data Update"
    End With
    OutlookAppointment appt
    MsgBox "Appointment Updated"
' delete the appointment
    With appt
        .booDelete = True
    End With
    OutlookAppointment appt
    MsgBox "Appointment Deleted"
End Sub
Question by:stevefriese
1 Comment

Accepted Solution

stevefriese earned 0 total points
ID: 37856694
I found out how.

 Set outFolder = outNameSpace.Folders.Item("SharePoint Lists")
Set outFolder = outFolder.Folders("name of calendar")

Featured Post

Free tool for managing users' photos in Office 365

Easily upload multiple users’ photos to Office 365. Manage them with an intuitive GUI and use handy built-in cropping and resizing options. Link photos with users based on Azure AD attributes. Free tool!

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

As a matter of fact, Outlook OST files are of much importance in relation to Exchange mailbox. OST files are independent as they are simply copy of data of a user’s mailbox on Exchange Server. Though, if the server’s status is changed or it is dama…
What to do if a split doesn't fit? Or a bunch of invoice lines must be rounded while the sum must match a total? It takes a little, but - when done - it is extremely easy to implement.
Watch the video of Kernel Migrator for SharePoint, which demonstrate the process easily of migration from SharePoint to SharePoint, OneDrive for Business & Google Drive servers, Public Folder to SharePoint, File Server to SharePoint. The tool has va…
If you are looking for an automated tool which can generate reports for Outlook emails and other items from PST file, then you can go for Kernel PST Reporter tool. The reports which are created by this tool are helpful to analyze and understand PST …

624 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