TimeStamp en macro VBA

Version imprimable

Bonjour,
Je cherche à faire une macro pour ajouter un "TimeStamp" en début du corps de texte d'un email ou d'une tâche.
Ca me servira pour faire un suivi...
Bref, en cherchant j'ai trouvé ce code ci-dessous sur cette page : https://www.outlook-tips.net/tips/in...contact-notes/
Code:

1 2 3 4 5 6 7 Sub TimeStamp() Dim objApp As Outlook.Application Dim Item As Object Set objApp = Application Set Item = objApp.ActiveInspector.CurrentItem Item.Body = "[Mon_nom]" & vbCrLf & Format(Now(), "dd/MM/YYYY h:mm:ss") & vbCrLf & vbCrLf & Item.Body End Sub
Ca fonctionne bien... Sauf que ça n'est pas du HTML et que cela supprime la mise en forme du texte qui est déjà contenu dans le corps du message ou de la tâche.
J'ai déjà essayé de remplacer Item.Body par Item.HTMLBody mais ça ne fonctionne pas.
Avez-vous une idée ?
Merci d'avance de votre aide,
Cordialement,

Bonjour,

Voici un exemple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Sub add_timestamp()
'---------------------------------------------------------------------------------------
' Procedure : add_timestamp
' Author    : Oliv
' Date      : 28/11/2018
' Purpose   : ajout un tampon date en HAUT DU MAIL
'---------------------------------------------------------------------------------------
'
    Dim obj As Object
    Dim Oitem As Outlook.MailItem
    Dim MonTexteEnPlus
    Dim OuCommenceAdresse, fin, BaliseBody, NbTiret, Separateur
 
    'choix de l'élément ACTIF
    Set obj = Application.ActiveWindow
    If TypeOf obj Is Outlook.Inspector Then
        Set obj = obj.CurrentItem
    Else
        Set obj = obj.Selection(1)
    End If
 
    If obj.Class <> olMail Then Exit Sub
    Set Oitem = obj
 
 
 
    MonTexteEnPlus = "[Mon_nom]" & "<br>" & Format(Now(), "dd/MM/YYYY h:mm:ss")
 
 
    Select Case Oitem.BodyFormat
        'ici on vérifie le format du message HTML OU BRUT ...
 
    Case olFormatHTML:
        Separateur = "<BR>"
        NbTiret = 45
        OuCommenceAdresse = InStr(1, Oitem.HTMLBody, "<BODY", vbTextCompare)
        If OuCommenceAdresse > 0 Then
            fin = InStr(OuCommenceAdresse + 5, Oitem.HTMLBody, ">") + 1
            BaliseBody = Mid(Oitem.HTMLBody, OuCommenceAdresse, fin - OuCommenceAdresse)
 
            Oitem.HTMLBody = Replace(Oitem.HTMLBody, BaliseBody, BaliseBody & "<font style='font-family: Tahoma ;font-size: 12pt ;color:red;font-style: italic;'>" & MonTexteEnPlus & "</font><BR>" _
                    & "<font style='font-family: Tahoma ;font-size: 12pt ;color:red;font-style: italic;'>" & String(NbTiret, "-") & "</font><BR><BR>", 1, 1, vbTextCompare)
        Else:
            Oitem.HTMLBody = "<font style='font-family: Tahoma ;font-size: 12pt ;color:red;font-style: italic;'>" & MonTexteEnPlus & _
                    "</font><BR>" & "<font style='font-family: Tahoma ;font-size: 12pt ;color:red;font-style: italic;'>" & String(NbTiret, "-") & "</font><BR><BR>" & Oitem.HTMLBody
 
        End If
    Case Else
        Separateur = Chr(10)
        NbTiret = 35
        Oitem.Body = Replace(MonTexteEnPlus, "<br>", vbCr) & Chr(10) & String(NbTiret, "-") & Chr(10) & Chr(10) & Oitem.Body
 
    End Select
 
Oitem.save
 
    Set obj = Nothing
    Set Oitem = Nothing
End Sub

28/11/2018, 15h39
bmtonweb

Un grand merci Oliv-
J'ai néanmoins une dernière question...
Faut-il que je fasse une macro pour les emails et une macro pour les tâches, ou est-ce possible d'avoir une seule et même macro pour les deux ?
28/11/2018, 16h33
Oliv-

Il y a effectivement un test fait sur le type d'item

Code:

If obj.Class <> olMail Then Exit Sub

essaye de changer en

Code:

If obj.Class <> olMail and obj.Class <>olTask Then Exit Sub

ou de supprimer cette ligne mais tu risques des erreurs
29/11/2018, 13h07
bmtonweb

Bonjour,
J'ai essayé les deux méthodes et ça ne fonctionne pas sur les tâches.
J'ai tout de suite un message d'erreur sur la ligne suivante, à savoir :

Code:

Set Oitem = obj

Je pense que c'est lié à la déclaration non ?

Code:

Dim Oitem As Outlook.MailItem

Faudrait que je mette un IF pour orienter le choix et que j'adapte le code pour Outlook.TaskItem
Je me trompe ?
Merci d'avance de votre aide,
Cordialement,
30/11/2018, 10h23
Oliv-

Bonjour,
oui tu as raison

il faut faire 2 cas car TASK N'a pas de bodyFormat et HTMLBODY