Créer un "Appointment" Outlook dans un calendrier spécifique

Le 30/10/2021 à 00:49

Bonjour Forum!!

J'aimerais voir un exemple de code qui permet d'exporter des appointments dans outlook dans un calendrier qu'on pourrait choisir à partir d'un combobox d'un userform.

Grâce à l'Aide de Thev (entre autres) je fais afficher mes noms de calendriers comme suit dans un combobox:

Sub stocker_calendriers()
On Error Resume Next
    Dim OLApp As New Outlook.Application
    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

End Sub

Private Sub UserForm_Initialize()
stocker_calendriers

    Dim rdv As Outlook.AppointmentItem
    Dim calendrier As Outlook.Folder

    Me.ComboBox1.List = dic_calendriers.Keys

End Sub

J'aimerais pouvoir exporter dans le calendrier choisi avec l'Aide de cette combobox

Pour l'instant j'Exporte ainsi (depuis project)

Private Sub ExporterOutlook()

Dim ol As Outlook.Application
Dim olAp As Outlook.AppointmentItem
Dim proj As Project
Dim t As Task
Dim pj As Project
Set pj = ActiveProject
For Each t In pj.Tasks
Set ol = New Outlook.Application
Set olAp = ol.CreateItem(olAppointmentItem)

n Error Resume Next
With olAp
    .Subject = t.Name
    .Start = t.Start
    .End = t.Finish
    .Save
    End With
Next t
End Sub

Par contre ca export dans le calendrier par défaut seulement .. j'ai fais beaucoup de recherches et d'essais .. rien ne fait

Merci!!

Le 02/11/2021 à 09:34

Bonjour Crackwood01,

Une piste ici : https://www.slipstick.com/developer/copy-new-appointments-to-another-calendar-using-vba/

Le 02/11/2021 à 12:37

Bonjour,

ci-dessous code :

Private Sub ComboBox1_Change()
    Dim calendrier As Outlook.Folder
    Dim rdv As Outlook.AppointmentItem

    Set calendrier = dic_calendriers(Me.ComboBox1.Value)
    Set rdv = calendrier.items.add

    On Error Resume Next
    With rdv
        .Subject = t.Name
        .Start = t.Start
        .End = t.Finish
        .Save
    End with

End Sub
Le 03/11/2021 à 04:54

Bonjour GVIALLES, Thev,

merci pour votre apport

GVIALLES: j'ai passé beaucoup de temps sur cette page à essayer et réessayer, rien de fonctionne, du moins, je n'y arrives pas.

Thev: merci pour ton code, par contre ca ne fonctionne pas, ca ne fonctionne que sur le calendrier par défaut et aussi la boucle qui passe par toutes les taches ne fonctionne plus, on ne voir que la dernière tâche.

Je l'ai mis dans CommandButton1_click() .. pas dans change()

Private Sub CommandButton1_click()
Dim ol As Outlook.Application
    Dim calendrier As Outlook.Folder
    Dim rdv As Outlook.AppointmentItem

    Set calendrier = dic_calendriers(Me.ComboBox1.Value)
    Set rdv = calendrier.Items.Add
Dim proj As Project
Dim t As Task
Dim pj As Project
Set pj = ActiveProject
For Each t In pj.Tasks
Set ol = New Outlook.Application

'On Error Resume Next
With rdv
    .Subject = t.Name
    .Start = t.Start
    .End = t.Finish
    .Categories = Me.ComboBox2.Value
    .Save

    End With
   Next t
Set ol = Nothing
End Sub
Le 03/11/2021 à 14:14

Bonjour,

Je ne vois pas l'intérêt de recréer pour chaque tâche une instance de l'application Outlook.

Ce code fonctionne chez moi :

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

Dim OLApp As New Outlook.Application
Dim dic_calendriers As New Dictionary

Private Sub UserForm_Initialize()

    stocker_calendriers
    Me.ComboBox1.List = dic_calendriers.Keys

End Sub

Private Sub CommandButton1_Click()
    Dim rdv As Outlook.AppointmentItem
    Dim calendrier As Outlook.Folder
    Dim tâche As Task
    Dim pj As Project

    Set calendrier = dic_calendriers(Me.ComboBox1.Value)

    Set pj = ActiveProject
    For Each tâche In pj.Tasks
        Set rdv = calendrier.Items.Add
        With rdv
            .Subject = tâche.Name
            .Start = tâche.Start
            .End = tâche.Finish
            .Categories = Me.ComboBox2.Value
            .Save
        End With
    Next tâche

End Sub

Sub stocker_calendriers()
    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

End Sub
Le 03/11/2021 à 15:12

Bonjour Crackwood01,

Peux-tu joindre ton classeur dans son état de développement actuel ?

Le 03/11/2021 à 15:40

Bonjour Thev, GVIALLES

Merci pour votre aide, même problême .. seulement fonctionnel dans le calendrier par défaut

Je joins mon fichier .. par contre ce n'est pas un classeur Excel c'Est un projet Microsoft Project

voici un lien de téléchargement:

http://crflix.ca/docs/Projet2.mpp

Le 03/11/2021 à 15:43

Voici un vidéo de ce que ca donne chez moi:

https://screenrec.com/share/mQTitc2KHl

Merci encore grandement de votre aide

Le 03/11/2021 à 22:01

Bonsoir,

ci-joint ton fichier modifié qui fonctionne parfaitement chez moi

33projet1.zip (39.66 Ko)
Le 04/11/2021 à 13:32

Merci Thev,

Ca ne fonctionne que si Outlook est fermé, si outlook est déjà ouvert j'ai une erreur 9 indice n'appartient pas à la sélection dans la procédure stocker_calendriers

J'ai essayé :

'// assignation explorateur
Set explorateur = Outlook.ActiveExplorer

mais ca ne fonctionne pas

on est très très proche!!!

MERCI!!

Le 04/11/2021 à 15:37

Bonjour,

Essayer cette modification :

'// ... 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 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

End Sub

Si vous avez encore une erreur, merci d'indiquer sur quelle instruction elle se produit.

Le 04/11/2021 à 16:37

Bonjour Thev,

l'erreur se situe dans la procédure stocker_calendrier .. impossible pour moi d'identifer la ligne .. ca me revoit ligne 0 avec " Erl "

mais, étrangement je dois dire en faisant ceci

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

au lieu de on error resume next ... tout fonctionne parfaitement ....

l'erreur était l'indice n'appartient pas à la sélection ... par curiosité, peux tu me dire comme voir la ligne d'erreur dans cette procédure?

Peut-etre que ca venait des calendriers de groupe qui ne semblent pas s'afficher ........

Je passe en résolu car .. ca fonctionne avec ta grande aide!!

Mon prochain défi: essayer de faire des mises à jours sur les items déjà dans le calendrier .... , je commence par essayer seul

encore une fois merci pour votre grande générosité à tous

Le 04/11/2021 à 20:49
par curiosité, peux tu me dire comme voir la ligne d'erreur dans cette procédure?
1- Mettre en place un point d'arrêt dans le code via la touche F9, par exemple à l'instruction : Set explorateur = OLApp.ActiveExplorer
2- Exécuter ensuite pas à pas via la touche F8
Rechercher des sujets similaires à "creer appointment outlook calendrier specifique"