Question : Outlook VBA code modification to include all calendar folders, not just default

I would like to modify the following code given by BlueDevilFan to include all calendar folders that are saved under my default calendar.  This code works great for simultaneously placing one appointment on two calendars.  When I place an appointment on my default calendar, this code automatically places it on my "calendarB."  I need for all the appointments that I place on all my sub-calendars under my default calendar to also be placed on the "calendarB."  Is there an easy way to do this? Code:

'Macro Begins Here
Private WithEvents objCalendarItems As Items

Private Sub Application_Startup()
    Set objCalendarItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub objCalendarItems_ItemAdd(ByVal Item As Object)
    Dim objAppointment As Outlook.AppointmentItem, _
        objFolder As Outlook.MAPIFolder
    If Item.Sensitivity <> olPrivate Then
        'Change the path to the shared calendar on the following line
        Set objFolder = OpenMAPIFolder("\Container\Folder\EECalendar")
        Set objAppointment = Item.Copy
        objAppointment.Move objFolder
        Set objAppointment = Nothing
        Set objFolder = Nothing
    End If
End Sub

Private Sub Application_Quit()
    Set objCalendarItems = Nothing
End Sub

'Credit where credit is due.
'The code below is not mine (well, a little of it is).  I found it somewhere on the
'internet but do not remember where or who the author is.  The original author(s)
'deserves all the credit for these functions.
Function OpenMAPIFolder(ByVal szPath As String)
    Dim app, ns, flr As MAPIFolder, szDir, i
    On Error GoTo errOMF
    Set flr = Nothing
    Set app = CreateObject("Outlook.Application")
    If Left(szPath, Len("\")) = "\" Then
        szPath = Mid(szPath, Len("\") + 1)
    Else
        Set flr = app.ActiveExplorer.CurrentFolder
    End If
    While szPath <> ""
        i = InStr(szPath, "\")
        If i Then
            szDir = Left(szPath, i - 1)
            szPath = Mid(szPath, i + Len("\"))
        Else
            szDir = szPath
            szPath = ""
        End If
        If IsNothing(flr) Then
            Set ns = app.GetNamespace("MAPI")
            Set flr = ns.Folders(szDir)
        Else
            Set flr = flr.Folders(szDir)
        End If
    Wend
    Set OpenMAPIFolder = flr
    On Error GoTo 0
    Exit Function
errOMF:
    Set OpenMAPIFolder = Nothing
    On Error GoTo 0
End Function

Function IsNothing(Obj)
  If TypeName(Obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
'Macro Ends Here

Answer : Outlook VBA code modification to include all calendar folders, not just default

buuduong,
> Would this be a problem if my default calendar is in exchange and my
> other calendars and shared calendar are in a personal folder
No.  Type mismatches are a result of the code expecting one item type when it's being given a different item type.  For example, declaring a variable or parameter as a MailItem and then trying to place an AppointmentItem in it.  Here are the two lines causing the problem:

    Set objGeorgeKellner = OpenMAPIFolder("\Personal Folders\GeorgeKellner")
    Set objDaleDrummond = OpenMAPIFolder("\Personal Folders\DaleDrummond")

It's my fault.  OpenMAPIFolder returns a MAPIFolder item and I'm trying to put that into variables that are defined as Items.  Replace the two lines above with these two lines:

    Set objGeorgeKellner = OpenMAPIFolder("\Personal Folders\GeorgeKellner").Items
    Set objDaleDrummond = OpenMAPIFolder("\Personal Folders\DaleDrummond").Items