VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UserForm1 
   Caption         =   "UserForm1"
   ClientHeight    =   3300
   ClientLeft      =   120
   ClientTop       =   465
   ClientWidth     =   5310
   OleObjectBlob   =   "UserForm1.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "UserForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'// ... cocher les références des bibliothèques Microsoft Outlook et Scripting Runtime
Option Explicit

Dim OLApp As Outlook.Application
Dim dic_calendriers As New Dictionary
Dim aCategories() As String

Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = True Then Me.ComboBox2.Enabled = True
If Me.CheckBox1.Value = False Then Me.ComboBox2.Enabled = False
End Sub

Private Sub ComboBox2_Change()

End Sub

Private Sub UserForm_Initialize()

    On Error Resume Next
    Set OLApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If OLApp Is Nothing Then
        Set OLApp = CreateObject("Outlook.Application")
        OLApp.Session.GetDefaultFolder(olFolderInbox).Display
        OLApp.ActiveExplorer.WindowState = olMinimized
    End If

    stocker_calendriers
    Me.ComboBox1.List = dic_calendriers.Keys

    Categories aCategories
    Me.ComboBox2.List = aCategories
    
    With Me.ComboBox3
        .AddItem "Projet entier"
        .AddItem "Tâches Sélectionnées"
    End With

Me.ComboBox1.ListIndex = 4
Me.ComboBox3.ListIndex = 0


End Sub


Private Sub CommandButton1_Click()
 'On Error Resume Next
    Dim rdv As Outlook.AppointmentItem
    Dim calendrier As Outlook.Folder
    Dim t As Task
    Dim pj As Project
    Dim rdvcheck As Outlook.AppointmentItem
    Dim Fournisseur As Outlook.Recipient
    Dim ChoixCategorie As Variant, ChoixExport As Variant
    Set calendrier = dic_calendriers(Me.ComboBox1.Value)

    Set pj = ActiveProject

    


If ComboBox3.ListIndex = 0 Then
    Set ChoixExport = ActiveProject
ElseIf ComboBox3.ListIndex = 1 Then
    Set ChoixExport = ActiveSelection
End If


    For Each t In ChoixExport.Tasks

If Me.CheckBox1.Value = True Then
    ChoixCategorie = Me.ComboBox2.Value
ElseIf Me.CheckBox1.Value = False Then
    ChoixCategorie = t.Text3
End If
 
 
     For Each rdvcheck In calendrier.Items

   If InStr(rdvcheck.subject, t.Name) <> 0 And InStr(rdvcheck.Categories, ChoixCategorie) <> 0 Then
    
       rdvcheck.Start = Replace(rdvcheck.Start, rdvcheck.Start, t.Start)
       rdvcheck.End = Replace(rdvcheck.End, rdvcheck.End, t.Finish)
       'rdvcheck.Send
        rdvcheck.Save
        MsgBox rdvcheck.subject
     
        
    ElseIf InStr(rdvcheck.subject, t.Name) = 0 And InStr(rdvcheck.Categories, ChoixCategorie) = 0 Then
        
               Set rdv = calendrier.Items.Add

        With rdv
            .subject = t.Name
            .Start = t.Start
            .End = t.Finish
            .Categories = ChoixCategorie
            .Recipients.Add (t.Text1)
            .Location = t.Text2
            .MeetingStatus = olMeeting
            '.Display
            '.Send
            .Save
        End With

        
        
        End If
        
Next rdvcheck


    Next t



End Sub

Sub Categories(ByRef zCategories() As String)
    Dim olobjCategory As Category
    Dim olstrOutput As String
    ReDim zCategories(0)
    Dim lNb As Long
    

    If OLApp.Session.Categories.Count > 0 Then
    
        For Each olobjCategory In OLApp.Session.Categories
           ReDim Preserve zCategories(lNb)
           zCategories(lNb) = olobjCategory.Name
           lNb = lNb + 1
           'olstrOutput = olstrOutput & olobjCategory.Name & vbCrLf
        Next
    End If
  
    Set olobjCategory = Nothing

 End Sub

Sub stocker_calendriers()
  On Error GoTo Err

    

    Dim explorateur As Outlook.Explorer
    Dim module As Outlook.NavigationModule
    Dim module_calendrier As Outlook.CalendarModule
    Dim groupe_calendriers As Outlook.NavigationGroup
    Dim calendrier_dossier As Outlook.NavigationFolder
    Dim calendrier As Outlook.Folder
    Dim nom_calendrier As String
    

    '// assignation explorateur
    Set explorateur = OLApp.ActiveExplorer
   
    '// stockage des calendriers
    For Each module In explorateur.NavigationPane.Modules
        If module.Class = olCalendarModule Then
            Set module_calendrier = module
            For Each groupe_calendriers In module_calendrier.NavigationGroups
                For Each calendrier_dossier In groupe_calendriers.NavigationFolders

                    'assignation du calendrier
                    Set calendrier = calendrier_dossier.Folder

                    'nom du calendrier
                    nom_calendrier = calendrier.Name & "-" & Split(calendrier.FolderPath, "\")(2)

                    'stockage calendriers dans le dictionnaire des calendriers
                    Set dic_calendriers(nom_calendrier) = calendrier

                Next calendrier_dossier
            Next groupe_calendriers
            Exit For
        End If
    Next module
    
Err:

   

End Sub