Newsgroup: it.comp.appl.access
Titolo: Path esatta di un calendario condiviso di Outlook

Ciao a tutti,
 
debbo richiamare un calendario condiviso per poterci aggiungere appuntamenti. 
 
Ho trovato il seguente codice:
 
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder 'get name of other persons folder
Dim objRecip As Outlook.Recipient 'other persons name
Dim strName As String 'the name or email of the persons folder
Dim objAppt As Outlook.AppointmentItem
Dim objApp As Outlook.Application
 
 
On Error Resume Next
 
strName = "
te...@contoso.com
"
 
Set objNS = objApp.GetNamespace("MAPI")
 
Set objRecip = objNS.CreateRecipient(strName)
 
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
 
'If Not objFolder Is Nothing Then
   ' Set objAppt = objFolder.Items.Add
 
   ' If objAppt Is Nothing Then
Set objAppt = objApp.CreateItem(olAppointmentItem)
   ' End If
 
 
'Else
    'MsgBox "no access to the folder meaning it is not shared"
'End If
 
 
        With objAppt
            .Start = Me.Data & " " & Me.OraInizio
            .End = Me.Data & " " & Me.OraFine
            .Subject = Me.NomeAppuntamento
            .ReminderMinutesBeforeStart = 20
            .BusyStatus = olBusy
            .Body = Me.Descrizione
            .Save
            .Display
        End With
 
 
 
Set objNS = Nothing
Set objFolder = Nothing
Set objRecip = Nothing
Set objApp = Nothing
 
Ma non aggiunge niente al calendario.
 
Oltre ad inserire il nome corretto dell'user che mi ha condiviso il calendario e cui abitualmente aggiungo appuntamenti "manualmente", ho provato ad inserire il nome visualizzato nelle proprietà di quel calendario. Ma in entrambi i casi non mi aggiunge niente.
 
Temo sia una mia mancanza nella denominazione esatta del calendario condiviso. Qualcuno di voi che mi può aiutare a capire?
 
Grazie
SimoneB

Dopo 3 giorni di sbattimento e dopo 10 minuti aver richiesto qua, ho trovato un codice alternativo che funziona alla grande. Per chiunque leggesse questo è quello corretto, almeno per Office 365. Ricordatevi di abilitare le librerie di Outlook xx.0 
 
Const olFolderCalendar = 9
Const olModuleCalendar = 1
Const olAppointmentItem = 1
Dim answer As Integer
Dim objNS
Dim objExpCal
Dim objNavMod
Dim objNavGroup
Dim objNavFolder
Dim objFolder
Dim colExpl
 
Set oApp = CreateObject("Outlook.Application")
Set objNS = oApp.Session
Set colExpl = oApp.Explorers
Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
 
For Each objNavGroup In objNavMod.NavigationGroups
    For Each objNavFolder In objNavGroup.NavigationFolders
        If Not objNavFolder = "Mario Rossi" Then '<<must be named exactly as in the nav pane in outlook
            GoTo NxtGroup
        End If
        On Error Resume Next
        Set objFolder = objNavFolder.Folder
 
NxtGroup:
    Next
Next
 
Set objCalendar = objFolder
Set objapt = objCalendar.Items.Add(olAppointmentItem)
 
    'create an appointment to schedule PM with outside contractor
    With objapt
        .Subject = Me.NomeAppuntamento
        .Start = Me.Data & " " & Me.OraInizio
        .End = Me.Data & " " & Me.OraFine
        .ReminderSet = True
        .ReminderMinutesBeforeStart = 20
        .Body = Me.Descrizione
        .Save
    End With
 
Set objNS = Nothing
Set objNavMod = Nothing
Set objNavGroup = Nothing
Set objNavFolder = Nothing
Set objFolder = Nothing
Set colExpl = Nothing

 Dopo 3 giorni di sbattimento e dopo 10 minuti aver richiesto qua, ho trovato un codice alternativo che funziona alla grande. Per chiunque leggesse questo è quello corretto, almeno per Office 365. Ricordatevi di abilitare le librerie di Outlook xx.0 
La dichiarazione delle variabili in quel modo è tipica per l'uso del latebinding, proprio per evitare la necessità di inserire il riferimento alla libreria di Outlook, ovviamente perdendo l'intellisense.
Dichiara esplicitamente "As Object" quello che è altrimenti subito viene inutilmente dimensionato come Variant per diventare solo dopo Object.
Per chiarezza di lettura modificherei questa parte
 
		If Not objNavFolder = "Mario Rossi" Then '<<must be named exactly as in the nav pane in outlook
			GoTo NxtGroup
		End If
		On Error Resume Next
		Set objFolder = objNavFolder.Folder
		NxtGroup:
 
in questo modo
 
		If objNavFolder = "Mario Rossi" Then '<<must be named exactly as in the nav pane in outlook
                       On Error Resume Next
	       	Set objFolder = objNavFolder.Folder
		End If
 
Valuta la riattivazione della gestione degli errore dopo averla disattivata con On Error Resume Next