Solved

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

Posted on 2012-04-13
1
1,236 Views
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
       
    Else
 
       ' 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"
       'Else
    End If
       
    With outappt
         If appt.booDelete Then
            .Delete
         Else
            If appt.dtmRecurrenceEnds = 0 Then
               .Start = appt.dtmStart
               If appt.booAllDayEvent Then
                  .AllDayEvent = True
               Else
                  .AllDayEvent = False
                  .Duration = appt.lngDuration
                  '.End = appt.dtmEnd
               End If
            Else
               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
                   Else
                      .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
            Else
               .ReminderSet = True
               .ReminderMinutesBeforeStart = appt.lngReminderMinutesBeforeStart
               .ReminderOverrideDefault = True
               .ReminderPlaySound = True
 '              .ReminderSoundFile = SysCmd(acSysCmdAccessDir) & "Reminder.wav"
            End If
         
            .Save
            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
     
AddAppt_Exit:
    Exit Function
 
AddAppt_Err:
    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
0
Comment
Question by:stevefriese
1 Comment
 
LVL 2

Accepted Solution

by:
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")
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Use email signature images to promote corporate certifications and industry awards.
Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

705 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

23 Experts available now in Live!

Get 1:1 Help Now