Leggere Appuntamenti Calendario di tutti gli account Outlook

[MAX Cubisino]

Buongiorno,

io ho la necessità di dover leggere gli appuntamenti di un calendario principale dell'utente 1 e copiarli sul calendario principale dell'utente 2 in modo silente.

Ora, la parte lettura Appuntamenti la so;
la parte scrittura nuovo appuntamento, ce l'ho;

La cosa che mi manca è cambiare l'account. +/- il codice è questo:
Try
Dim oApp As Outlook.Application
Dim oCalFolder As Outlook.MAPIFolder
Dim oAppt As Outlook.AppointmentItem
oApp = New Outlook.Application
oCalFolder = oApp.Application.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
For Each oAppt In oCalFolder.Items
If Year(oAppt.Start) >= Year(Now()) Then
Debug.Print(String.Concat("APPUNTAMENTO: ", oAppt.Subject, " INI: ", oAppt.Start, " END: ", oAppt.End))
'--------------------------
'--- INSERT CODE FOR ADD ITEMS TO CALENDAR OF ACCOUNT 2
'--------------------------
End If
Next
oAppt = Nothing
oCalFolder = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try

Qualcuno può aiutarmi?

Grazie.

Saluti