Utiliser todo.txt avec Outlook (macros VBA)

J’utilise depuis plusieurs semaines todo.txt, une syntaxe permettant de gérer simplement et efficacement ses listes de tâches. J’emploie deux logiciels pour modifier et consulter les dites listes : SimpleTask sous Android et Topydo (en mode « prompt ») sous Windows.

Cependant, pour fluidifier quelque peu l’utilisation de ce système − et en particulier l’ajout de nouvelles tâches − il me fallait un moyen de créer des tâches directement depuis ma messagerie Outlook. Plus précisément, le besoin est double :

  • Ajouter une tâche contenant le terme « Répondre », le nom de l’expéditeur, l’objet du message et tag @1-faire pour un courriel entrant méritant une réponse. Le courriel est ensuite archivé (dès qu’il faut l’objet d’une tâche, un courriel sort de l’inbox)
  • Ajouter une tâche contenant le nom du destinataire, l’objet du message et le tag @1-attendre_relancer pour certains courriels envoyés nécessitant un suivi

Dans les deux cas, je fixe également une date de seuil (« t: » en syntaxe todo.txt) et d’échéance (« due: »). La tâche ainsi créée est proposée à l’édition dans une MsgBox pour faciliter sa modification.

On débute par une fonction gérant l’écriture en utf-8 dans le fichier todo.txt, directement issue de cette page :

'Function saves cText in file, and returns 1 if successful, 0 if not
'Source : https://gist.github.com/JoBrad/1023484
Public Function writeOut(cText As String) As Integer
    On Error GoTo errHandler
    Dim fsT, tFilePath As String
    Dim sTodo_list As String

    tFilePath = "D:\Notes Nextcloud\todo.txt"

   'Create Stream object
    Set fsT = CreateObject("ADODB.Stream")

    'Specify stream type - we want To save text/string data.
    fsT.Type = 2

    'Specify charset For the source text data.
    fsT.Charset = "utf-8"

    'Open the stream And write binary data To the object
    fsT.Open
    ' On charge les tâches existantes dans le stream
    fsT.LoadFromFile tFilePath
    ' On se place à la fin du stream (sinon la nouvelle tâche est ajoutée au début)
    fsT.Position = fsT.Size
    fsT.writetext cText

    'Save binary data To disk
    fsT.SaveToFile tFilePath, 2

    GoTo finish

errHandler:
    MsgBox (Err.Description)
    writeOut = 0
    Exit Function

finish:
    writeOut = 1
End Function

Cette premier macro ajoute une tâche liée à un courriel sortant pour lequel un suivi est nécessaire :

Sub Todo_Attendre()

    ' Ajoute le mail sélectionné à la todolist

    Dim olItem As Outlook.MailItem
    Dim sText As String
    Dim sSujet As String
    Dim sTodo_c As String
    Dim sTodo As String
 
    Set olItem = ActiveExplorer.Selection.Item(1)
 
    auj = Format(Date, "yyyy-mm-dd")
    due = "due:" & Format(DateAdd("d", 7, Date), "yyyy-mm-dd")
    seuil = "t:" & Format(DateAdd("d", 6, Date), "yyyy-mm-dd")
 
    sDestinataire = olItem.Recipients(1)
    sSujet = olItem.Subject
    sTodo_c = auj & " Retour de " & sDestinataire & " sur " & sSujet & " @1-attentre_relancer @2-internet " & seuil & " " & due
 
    Dim Nom As String
    sTodo = InputBox("Tâches : ", "Todo.txt", sTodo_c)
 
    ecriture = writeOut(sTodo)

End Sub

Et enfin, cette seconde macro est lancée sur un courriel entant méritant une réponse :
Sub Todo_Repondre()

    Dim olItem As Outlook.MailItem
    Dim sText As String
    Dim sSujet As String
    Dim sTodo_c As String
    Dim sTodo As String
 
    Set olItem = ActiveExplorer.Selection.Item(1)
 
    auj = Format(Date, "yyyy-mm-dd")
    due = "due:" & Format(DateAdd("d", 1, Date), "yyyy-mm-dd")
    seuil = "t:" & auj
 
    sExpediteur = olItem.SenderName()
    sSujet = olItem.Subject
    sTodo_c = auj & " Répondre à " & sExpediteur & " sur " & sSujet & " @1-faire @2-internet " & seuil & " " & due
 
    Dim Nom As String
    sTodo = InputBox("Tâches : ", "Todo.txt", sTodo_c)
 
    ecriture = writeOut(sTodo)

    ' On déplace le mail dans la boîte d'archive
    Dim myNameSpace As Outlook.NameSpace
    Dim myInbox As Outlook.Folder
    Dim oArchive As Outlook.Folder
 
    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set oArchive = myInbox.Parent.Folders("Archives").Folders("2018")
 
    olItem.Move oArchive
 
End Sub

Ces macros sont certainement très largement perfectibles ! En tout cas elles semblent fonctionner…

 

jln

 

Laisser un commentaire

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur comment les données de vos commentaires sont utilisées.