pierre3401
XLDnaute Nouveau
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
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