Outlook calendar push...

Hi, RIrvine1206.

Outlook does not have a built-in means of doing this.  It is possible with a bit of scripting.  The script won't do a true sync.  It will simply push an entry you make on your calendar to the other calendar.  If that's acceptable, then I can post the code and instructions on how to use it.

That sounds great, I would appreciate it a lot!

Ok, this should do it.  This code monitors your calendar and copies any appointments/meetings you add that are not marked "private" to the shared calendar.  Keep in mind that this is a one way process.  Appointments that are added to the shared calendar are not copied to your calendar.  Also changes you make to existing appointments will not be copied to the shared calendar.  That goes for deletions too.

Follow these instructions to add the code to Outlook.

For Outlook 2003 and Earlier

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession
4.  Copy the code from the Code Snippet box and paste it into the right-hand pane of
5.  Outlook's VB Editor window
6.  Edit the code as needed.  I included comment lines wherever something needs to or can change
7.  Click the diskette icon on the toolbar to save the changes
8.  Close the VB Editor
9.  Click Tools > Macro > Security
10. Set the Security Level to Medium
11. Close Outlook
12. Start Outlook
13. Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run.  Say yes.


For Outlook 2007

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession
4.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
5.  Edit the code as needed.  I included comment lines wherever something needs to or can change
6.  Click the diskette icon on the toolbar to save the changes
7.  Close the VB Editor
8.  Click Tools > Trust Center
9.  Click Macro Security
10. Set Macro Security to "Warnings for all macros"
11. Click OK
12. Close Outlook
13. Start Outlook.  Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run.  Say yes.

Understanding Outlook Folder Paths

A folder path in Outlook is essentially the same as a folder path in the file system.  The one difference being that Outlook folder paths do not include a drive letter.  The path to a folder is a list of all the folders from the root to the target folder with each folder name separated from the preceding folder name by a backslash (i.e. \).  Consider the following folder structure:

Mailbox - Doe, John
    - Calendar
    - Inbox
    - Tasks
Personal Folders
    + Marketing
        + Proposals
        + Reviews
    + Projects
        + Project 1
        + Project 2

The path to "Inbox" is "Mailbox - Doe, John\Inbox".
The path to "Reviews" is "Personal Folders\Marketing\Reviews".
The path to "Project 1" is "Personal Folders\Projects\Project 1".

Private WithEvents olkCal As Items

Private Sub Application_Startup()
    Set olkCal = Session.GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub olkCal_ItemAdd(ByVal Item As Object)
    Dim olkApt As Outlook.AppointmentItem, _
        olkFld As Outlook.MAPIFolder
    If Item.Sensitivity <> olPrivate Then
        'On the next line change the path to the shared calendar'
        Set olkFld = OpenOutlookFolder("Container\Folder\EECalendar")
        Set olkApt = Item.Copy
        olkApt.Move olkFld
        Set olkApt = Nothing
        Set olkFld = Nothing
    End If
End Sub

Private Sub Application_Quit()
    Set olkCal = Nothing
End Sub

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    ' Purpose: Opens an Outlook folder from a folder path.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        bolBeyondRoot As Boolean
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function

Select allOpen in new window

It runs and copies the entry over... But it also gives a runtime error '-2147221241 (80040107)': The operation failed.

Under the debug it points to line 10

If Item.Sensitivity <> olPrivate Then...
 Then it prevents the macro from running again until I restart Outlook.


The only line I edited was line 11:

Set olkFld = OpenOutlookFolder("Mailbox - Irvine, Rick\Calendar\Test")

Any thoughts?

Works great now... Thanks!!!

You're welcome!