Créer une series de tâches depuis excell VBA

[pierre3401]

Bonjour,

A partir du code ci-dessous, je peux créer une series de tâches planifiées se rapportant à un projet, je recevrai alors un rappel à intervalles réguliers pour chaque étape de l'avancement dudit projet.
Cependant, j'ai plusieurs projets en charge et jj'aurais voulu savoir s'il était possible d'insérrer un code qui créera
un sous-dossier dans les tâches outlook rassemblant toutes les tâches d'un même projet.

Est-ce possible ?


Merci d'avance,



Sub Creer_TacheOutlook()
' Dimensionner l'objet Outlook
Dim oOutlook As Outlook.Application
' Dimensionner la tâche
Dim oTache As TaskItem
Dim sélect As Integer

' Initialiser l'objet Outlook
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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + 1 ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A1") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q5") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A2") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q6") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A3") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q7") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A4") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q8") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A5") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q9") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A6") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q10") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A7") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q11") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A8") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q12") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A9") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q13") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A10") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q14") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A11") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q15") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A12") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q16") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A13") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q17") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A14") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q18") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A15") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q19") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A16") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q20") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A117") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With

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 = Range("D3") 'Date de épart
.DueDate = Range("D3") + Range("Q21") ' Echéance
.Subject = Range("A1") + " Avec " + Range("D9") ' Objet
.Body = Sheets("Liste des Tâches").Range("A18") ' texte explicatif
.ReminderSet = True
.Save ' Enregistrer la nouvelle tâche
End With
' vider les objets pour libérer la mémoire
Set oTache = Nothing
Set oOutlook = Nothing


'fermeture du fichier sans enregistrer !

Application.Quit
Application.DisplayAlerts = False

End Sub

 

[pierre3401]

Re : Créer une series de tâches depuis excell VBA

Bonjour,

J'ai un autre problème...
Si ce code fonctionne parfaitement sur mon pc, lorsque je veux l'exécuter sur un autre pc, j'ai un message d'erreur en retour, ça me renvoie "type mismatch" sans que je comprenne pourquoi