Discussion :

[jopont]

Bonjour,

Avec la macro ci-dessous, je parviens à exporter un fichier CSV de l'agenda outlook du dossier par défaut.
Je souhaiterais pouvoir faire la même chose avec l'agenda partagé sur le réseau.
Comment écrire le code VBA.
Aussi est-ce possible de dire dans le code que je veux exporter seulement les éléments du jour jusqu'à 1 mois ?
Merci pour vos réponses.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Sub Outlook_Vba_Get_Calendar_Item_Appoinments()
    Dim oWorkbook As Workbook, Calendar_To_Excel_File As String
    Dim oOutlook_Calendar As Outlook.Folder, oCalendar_Items As Outlook.Items
    Dim oCalendarAppointment As Outlook.AppointmentItem
    Dim iRow As Double
 
    iRow = 1
 
    'Change path of the Target File name if required
    Calendar_To_Excel_File = "C:\Users\xxxxxx\Desktop\En cours\FDGCTA\test.csv"
    'Check if Output File already exists
    If VBA.Dir(Calendar_To_Excel_File) = "" Then
        'To Create New Workbook
        Set oWorkbook = Workbooks.Add
        oWorkbook.SaveAs Calendar_To_Excel_File
    Else
        'To Refer Already Created Workbook
        Set oWorkbook = Workbooks.Open(Calendar_To_Excel_File)
    End If
 
    'Get object reference for Outlook Calendar folder
   Set oOutlook_Calendar = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
    Set oCalendar_Items = oOutlook_Calendar.Items
 
    'Loop Thru Each Items in Outlook Calendar
    For Each oCalendarAppointment In oCalendar_Items
        oWorkbook.Sheets(1).Cells(iRow, 1) = oOutlook_Calendar.FolderPath
        oWorkbook.Sheets(1).Cells(iRow, 2) = oCalendarAppointment.Start
        oWorkbook.Sheets(1).Cells(iRow, 3) = oCalendarAppointment.End
        oWorkbook.Sheets(1).Cells(iRow, 4) = oCalendarAppointment.Subject
        oWorkbook.Sheets(1).Cells(iRow, 5) = oCalendarAppointment.Location
        oWorkbook.Sheets(1).Cells(iRow, 6) = oCalendarAppointment.Duration
        oWorkbook.Sheets(1).Cells(iRow, 7) = oCalendarAppointment.Size
        'oWorkbook.Sheets(1).Cells(irow, 8) = oCalendarAppointment.Body
        iRow = iRow + 1
    Next
 
    'Save Excel Workbook With Calendar Appointments
    oWorkbook.Save
    oWorkbook.Close False  'Close Workbook without any Warning
    MsgBox "Outlook Calendar Appointments Downloaded To:" & Calendar_To_Excel_File
 
End Sub

[jopont]

Bonsoir,

J'ai essayé d'aller cherche le calendrier partagé avec cette macro, mais j'ai une erreur 91 erreur de bloc with....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub TrouveCalendrierPartagé()
'---------------------------------------------------------------------------------------
' Procedure : ListeCalendrierPartagé
' Author    : Oliv-
' Date      : 19/02/2014
' Purpose   : Liste les des "calendrier partagé" et le Dossier correpondant
'---------------------------------------------------------------------------------------
'
    Dim objNS As Outlook.namespace
    Dim objExpCal As Outlook.Explorer
    Dim objNavMod As Outlook.CalendarModule
    Dim objNavCalPart As Outlook.NavigationFolders
    Dim i, MonSousDoss
 
    nom = "agenda"
    Set objNS = Application.Session
    Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
    Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
 
 
    Set objNavCalPart = objNavMod.NavigationGroups.Item("Dossiers publics\Favoris").NavigationFolders
    For i = 1 To objNavCalPart.Count
        If objNavCalPart(i).DisplayName = nom Then
            Set MonSousDoss = objNavCalPart(i)
            On Error Resume Next
 
            FoldName = MonSousDoss.folder.Name & "-" & MonSousDoss.folder.FullFolderPath
            If Err Then FoldName = "Pas accessible"
           MsgBox MonSousDoss & "-->" & FoldName
 
              Exit For
        End If
    Next i
End Sub

Je ne parviens pas à aller chercher le calendrier partagé.
Merci pour votre aide