Sub CreateDossierTask()
 
    Dim monOutlook As New Outlook.Application
    Dim ns As NameSpace
    Dim dossier As MAPIFolder
    Dim myNewFolder As MAPIFolder
 
    Set ns = monOutlook.GetNamespace("MAPI")
    Set dossier = ns.Folders("Mailbox - BOULANGER PIERRE").Folders("Tasks")
    Set myNewFolder = dossier.Folders.Add("Test")
 
'appeller la fonction de création de la tâche
Creer_TacheOutlook
 
End Sub
 
Sub Creer_TacheOutlook()
 
    ' Dimensionner l'objet Outlook
    Dim oOutlook As Outlook.Application
    ' Dimensionner la tâche
    Dim oTache As TaskItem
 
        Set oOutlook = CreateObject("Outlook.Application")     ' Créer la tâche
        Set oTache = oOutlook.CreateItem(olTaskItem)           ' Affecter les propriétés à la tâche
 
 
With oTache
    .Status = olTaskInProgress
    .Importance = olImportanceHigh
    .StartDate = Now  'Date de épart
    .DueDate = Now + 5   ' Echéance
    .Subject = "Test " ' Objet
    .Body = "Test de création de tâches dans un sous-dossier"  ' texte explicatif
    .Save ' Enregistrer la nouvelle tâche
End With
 
' vider les objets pour libérer la mémoire
Set oTache = Nothing
Set oOutlook = Nothing
 
End Sub