Warning si oubli de joindre la piece jointe

**hajarita65** · 18/10/2016, 15h30

Bonjour à tous,

J'ai ce code : Pour me rappeler, si j'ai le mot joint dans mon mail, de joindre le document en cas d'oublie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'    Call CheckItemSend(Item, Cancel)
    Dim mail As MailItem
    Dim objAttachment As Attachments
    Dim msg As String
    Dim nbre_pj As Integer
    If Item.Class = olMail Then
       Set mail = Item
        Set objAttachment = Item.Attachments ' Récupération des pièces jointes
        nbre_pj = objAttachment.Count ' Calcul du nombre de pièces jointes
        If (nbre_pj = 0) Then ' ATTENTION A PARAMETRER EN FONCTION DE LA SIGNATURE QUI OCCUPE 1 PIECE JOINTE
            msg = mail.Body
             'Liste des mots recherchés
            If (InStr(1, msg, "PJ", vbTextCompare) Or _
                InStr(1, msg, "jointes", vbTextCompare) Or _
                InStr(1, msg, "joint", vbTextCompare) Or _
                InStr(1, msg, "jointe", vbTextCompare) Or _
                InStr(1, msg, "joints", vbTextCompare)) Then
                If (MsgBox("Il semblerait que vous n'ayez ajouté aucune pièce jointe. Voulez-vous quand même envoyer ce message ?", vbYesNo + vbExclamation, "Attention") = vbNo) Then
                    Cancel = True
                    Exit Sub
                End If
            End If
        End If
    End If
End Sub

Mon problème est si par exemple j'ai le mot "ADJOINT" DANS MON MAIL JE VAIS AVOIR LE WARNING aussi. Y a t-il un moyen pour exclure par exemple ce mot adjoint de la liste de recherche.

Merci par avance,

**Jean-Philippe André** · 18/10/2016, 16h48

Salut,

je dirais en ajoutant un espace avant pour etre "sur"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
(InStr(1, msg, " PJ", vbTextCompare) Or _
                InStr(1, msg, " joint", vbTextCompare)  Then

"joint" couvrant les autres variantes d'accords.

Reste le probleme de "jointure" mais cela depend du contenu type des mails que tu risques d'envoyer =]

**hajarita65** · 18/10/2016, 16h51

Oui, c'est ce que j'ai fait. Mais je me suis dis peut être il y a un moyen pour exclure des mots de la liste de recherche.

Merci

**Jean-Philippe André** · 18/10/2016, 16h52

Certes, mais si tu as les deux mots dans ton mail, tu feras quoi ?

**hajarita65** · 18/10/2016, 17h26

Envoyé par Jean-Philippe André

Certes, mais si tu as les deux mots dans ton mail, tu feras quoi ?

Bonne question :-D

**Jean-Philippe André** · 18/10/2016, 17h37

Donc je pense que la logique du "joint" fera l'affaire

Apres tu peux faire tous les cas auxquels tu penses :
- " joint "
- " joint,"
- " joint."

plus les fautes d'orthographe ?

**hajarita65** · 18/10/2016, 17h41

Envoyé par Jean-Philippe André

Donc je pense que la logique du "joint" fera l'affaire

Apres tu peux faire tous les cas auxquels tu penses :
- " joint "
- " joint,"
- " joint."

plus les fautes d'orthographe ?

Je pense avec espace ça y ira

Merci pour votre aide

**Oliv-** · 19/10/2016, 10h13

Bonjour,
Sinon il faut utiliser les REGEX, qui permettent de trouver un mot complet.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function ISmotPresentRegex(Montexte, Mot) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : ISmotPresentRegex
' Author    : OLIV- from original code brettdj
' Date      : 19/10/2016
' Purpose   : Cherche un mot complet
'---------------------------------------------------------------------------------------
'
    Dim objRegex As Object
    Dim objRegM As Object
    Dim MailHeader As String
    Dim ExtractText As String
    Dim i
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        'Prepare a regular expression object
        .Global = True
        .IgnoreCase = True
        .Pattern = "\b" & Mot & "\b"
       ISmotPresentRegex = .test(Montexte)
    End With
End Function
 
 
Private Sub Test_ReplaceRegex()
    Dim ol As Outlook.Application
    If UCase(Application) = "OUTLOOK" Then
        Set ol = Application
    Else
        Set ol = CreateObject("outlook.application")
    End If
    Dim item As Outlook.MailItem
    Set item = ol.ActiveInspector.CurrentItem
 
 
    MsgBox ISmotPresentRegex(item.Body, "joint")
End Sub

**hajarita65** · 19/10/2016, 11h17

Envoyé par Oliv-

Bonjour,
Sinon il faut utiliser les REGEX, qui permettent de trouver un mot complet.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function ISmotPresentRegex(Montexte, Mot) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : ISmotPresentRegex
' Author    : OLIV- from original code brettdj
' Date      : 19/10/2016
' Purpose   : Cherche un mot complet
'---------------------------------------------------------------------------------------
'
    Dim objRegex As Object
    Dim objRegM As Object
    Dim MailHeader As String
    Dim ExtractText As String
    Dim i
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        'Prepare a regular expression object
        .Global = True
        .IgnoreCase = True
        .Pattern = "\b" & Mot & "\b"
       ISmotPresentRegex = .test(Montexte)
    End With
End Function
 
 
Private Sub Test_ReplaceRegex()
    Dim ol As Outlook.Application
    If UCase(Application) = "OUTLOOK" Then
        Set ol = Application
    Else
        Set ol = CreateObject("outlook.application")
    End If
    Dim item As Outlook.MailItem
    Set item = ol.ActiveInspector.CurrentItem
 
 
    MsgBox ISmotPresentRegex(item.Body, "joint")
End Sub

Bonjour,

J'ai essayé votre code comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'    Call CheckItemSend(Item, Cancel)
    Dim mail As MailItem
    Dim objAttachment As Attachments
    Dim msg As String
    Dim nbre_pj As Integer
    If Item.Class = olMail Then
       Set mail = Item
        Set objAttachment = Item.Attachments ' Récupération des pièces jointes
        nbre_pj = objAttachment.Count ' Calcul du nombre de pièces jointes
        If (nbre_pj = 0) Then ' ATTENTION A PARAMETRER EN FONCTION DE LA SIGNATURE QUI OCCUPE 1 PIECE JOINTE
            msg = mail.Body
             'Liste des mots recherchés
            If (ISmotPresentRegex(msg, joint) = True) Then
                If (MsgBox("Il semblerait que vous n'ayez ajouté aucune pièce jointe. Voulez-vous quand même envoyer ce message ?", vbYesNo + vbExclamation, "Attention") = vbNo) Then
                    Cancel = True
                    Exit Sub
                End If
            End If
        End If
    End If
End Sub
 
Function ISmotPresentRegex(Montexte, Mot) As Boolean
 
    Dim objRegex As Object
    Dim objRegM As Object
    Dim MailHeader As String
    Dim ExtractText As String
    Dim i
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        'Prepare a regular expression object
        .Global = True
        .IgnoreCase = True
        .Pattern = "\b" & Mot & "\b"
       ISmotPresentRegex = .test(Montexte)
    End With
End Function

Mias ça ne marche pas encore, je pense que j'ai loupé quelque chose!

Merci pour votre aide

**Oliv-** · 19/10/2016, 14h45

il faut mettre des guillemets

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 If (ISmotPresentRegex(msg, "joint") = True) Then

**hajarita65** · 19/10/2016, 14h47

Envoyé par Oliv-

il faut mettre des guillemets

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 If (ISmotPresentRegex(msg, "joint") = True) Then

Oui j'ai mis les guillemets. Mais ça ne marche pas!

**Oliv-** · 19/10/2016, 15h20

C'est sans doute à cause du nombre de PJ et de la signature

voici pour exclure les pj dans le corps du mail

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
  Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  Dim mail As MailItem
    Dim objAttachments As Attachments
    Dim msg As String
    Dim nbre_pj As Integer
    If Item.Class = olMail Then
       Set mail = Item
        Set objAttachments = Item.Attachments ' Récupération des pièces jointes
         ' Calcul du nombre de pièces jointes
        nbre_pj = 0
        For i = 1 To objAttachments.Count
        If Not PJ_Isembedded(objAttachments(i)) Then
        nbre_pj = nbre_pj + 1
        End If
        Next i
 
        If (nbre_pj = 0) Then ' ATTENTION A PARAMETRER EN FONCTION DE LA SIGNATURE QUI OCCUPE 1 PIECE JOINTE
            msg = mail.Body
             'Liste des mots recherchés
            If (ISmotPresentRegex(msg, "joint") = True) Then
                If (MsgBox("Il semblerait que vous n'ayez ajouté aucune pièce jointe. Voulez-vous quand même envoyer ce message ?", vbYesNo + vbExclamation + vbDefaultButton2, "Attention") = vbNo) Then
                    Cancel = True
                    Exit Sub
                End If
            End If
        End If
    End If
end sub

avec ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function PJ_Isembedded(ByVal pj As Attachment) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : PJ_Isembedded pour OL2010
' Author    : OLIV-
' Date      : 05/06/2015
' Version   : 3
' Purpose   : Indique si une PIECE JOINTE est INCORPOREE dans le Corps du Mail
'---------------------------------------------------------------------------------------
'
    Dim oPA As Outlook.PropertyAccessor
 
    Dim ATTACH_MIME_TAG
    Dim ATTACH_CONTENT_ID
    Dim ATTACHMENT_HIDDEN
    Dim ATTACH_FLAGS
    Dim ATTACH_CONTENT_LOCATION
    Dim ATTACH_METHOD
 
 
    Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
    Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Const PR_ATTACH_FLAGS = "http://schemas.microsoft.com/mapi/proptag/0x37140003"
    Const PR_ATTACH_CONTENT_LOCATION = "http://schemas.microsoft.com/mapi/proptag/0x3713001E"
    Const PR_ATTACH_METHOD = "http://schemas.microsoft.com/mapi/proptag/0x37050003"
 
    Set oPA = pj.PropertyAccessor
 
    On Error Resume Next
    ATTACH_MIME_TAG = oPA.GetProperty(PR_ATTACH_MIME_TAG)
    ATTACHMENT_HIDDEN = oPA.GetProperty(PR_ATTACHMENT_HIDDEN)
    ATTACH_CONTENT_ID = oPA.GetProperty(PR_ATTACH_CONTENT_ID)
    ATTACH_FLAGS = oPA.GetProperty(PR_ATTACH_FLAGS)
    ATTACH_CONTENT_LOCATION = oPA.GetProperty(PR_ATTACH_CONTENT_LOCATION)
    ATTACH_METHOD = oPA.GetProperty(PR_ATTACH_METHOD)
 
    'MsgBox pj & vbCr & "PR_ATTACH_MIME_TAG=" & ATTACH_MIME_TAG _
     & vbCr & "PR_ATTACHMENT_HIDDEN=" & ATTACHMENT_HIDDEN _
     & vbCr _
     & vbCr & "PR_ ATTACH_CONTENT_ID=" & ATTACH_CONTENT_ID _
     & vbCr & "PR_ATTACH_FLAGS=" & ATTACH_FLAGS _
     & vbCr & "PR_ATTACH_CONTENT_LOCATION=" & ATTACH_CONTENT_LOCATION _
     & vbCr & "PR_ATTACH_METHOD=" & ATTACH_METHOD
 
    '  if PR_ATTACH_FLAGS value has the 4 bit set (ATT_MHTML_REF) then
    '              attachment is inline
    '       Else
    '              attachment is normal
    If (ATTACH_CONTENT_ID <> "" And ATTACH_FLAGS = 4) Or ATTACH_METHOD = 6 Or InStr(1, pj.Parent.HTMLBody, ATTACH_CONTENT_ID, vbTextCompare) > 0 Then
        PJ_Isembedded = True
    Else
        PJ_Isembedded = False
    End If
 
End Function

**hajarita65** · 19/10/2016, 15h57

Envoyé par Oliv-

C'est sans doute à cause du nombre de PJ et de la signature

voici pour exclure les pj dans le corps du mail

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
  Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  Dim mail As MailItem
    Dim objAttachments As Attachments
    Dim msg As String
    Dim nbre_pj As Integer
    If Item.Class = olMail Then
       Set mail = Item
        Set objAttachments = Item.Attachments ' Récupération des pièces jointes
         ' Calcul du nombre de pièces jointes
        nbre_pj = 0
        For i = 1 To objAttachments.Count
        If Not PJ_Isembedded(objAttachments(i)) Then
        nbre_pj = nbre_pj + 1
        End If
        Next i
 
        If (nbre_pj = 0) Then ' ATTENTION A PARAMETRER EN FONCTION DE LA SIGNATURE QUI OCCUPE 1 PIECE JOINTE
            msg = mail.Body
             'Liste des mots recherchés
            If (ISmotPresentRegex(msg, "joint") = True) Then
                If (MsgBox("Il semblerait que vous n'ayez ajouté aucune pièce jointe. Voulez-vous quand même envoyer ce message ?", vbYesNo + vbExclamation + vbDefaultButton2, "Attention") = vbNo) Then
                    Cancel = True
                    Exit Sub
                End If
            End If
        End If
    End If
end sub

avec ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function PJ_Isembedded(ByVal pj As Attachment) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : PJ_Isembedded pour OL2010
' Author    : OLIV-
' Date      : 05/06/2015
' Version   : 3
' Purpose   : Indique si une PIECE JOINTE est INCORPOREE dans le Corps du Mail
'---------------------------------------------------------------------------------------
'
    Dim oPA As Outlook.PropertyAccessor
 
    Dim ATTACH_MIME_TAG
    Dim ATTACH_CONTENT_ID
    Dim ATTACHMENT_HIDDEN
    Dim ATTACH_FLAGS
    Dim ATTACH_CONTENT_LOCATION
    Dim ATTACH_METHOD
 
 
    Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
    Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Const PR_ATTACH_FLAGS = "http://schemas.microsoft.com/mapi/proptag/0x37140003"
    Const PR_ATTACH_CONTENT_LOCATION = "http://schemas.microsoft.com/mapi/proptag/0x3713001E"
    Const PR_ATTACH_METHOD = "http://schemas.microsoft.com/mapi/proptag/0x37050003"
 
    Set oPA = pj.PropertyAccessor
 
    On Error Resume Next
    ATTACH_MIME_TAG = oPA.GetProperty(PR_ATTACH_MIME_TAG)
    ATTACHMENT_HIDDEN = oPA.GetProperty(PR_ATTACHMENT_HIDDEN)
    ATTACH_CONTENT_ID = oPA.GetProperty(PR_ATTACH_CONTENT_ID)
    ATTACH_FLAGS = oPA.GetProperty(PR_ATTACH_FLAGS)
    ATTACH_CONTENT_LOCATION = oPA.GetProperty(PR_ATTACH_CONTENT_LOCATION)
    ATTACH_METHOD = oPA.GetProperty(PR_ATTACH_METHOD)
 
    'MsgBox pj & vbCr & "PR_ATTACH_MIME_TAG=" & ATTACH_MIME_TAG _
     & vbCr & "PR_ATTACHMENT_HIDDEN=" & ATTACHMENT_HIDDEN _
     & vbCr _
     & vbCr & "PR_ ATTACH_CONTENT_ID=" & ATTACH_CONTENT_ID _
     & vbCr & "PR_ATTACH_FLAGS=" & ATTACH_FLAGS _
     & vbCr & "PR_ATTACH_CONTENT_LOCATION=" & ATTACH_CONTENT_LOCATION _
     & vbCr & "PR_ATTACH_METHOD=" & ATTACH_METHOD
 
    '  if PR_ATTACH_FLAGS value has the 4 bit set (ATT_MHTML_REF) then
    '              attachment is inline
    '       Else
    '              attachment is normal
    If (ATTACH_CONTENT_ID <> "" And ATTACH_FLAGS = 4) Or ATTACH_METHOD = 6 Or InStr(1, pj.Parent.HTMLBody, ATTACH_CONTENT_ID, vbTextCompare) > 0 Then
        PJ_Isembedded = True
    Else
        PJ_Isembedded = False
    End If
 
End Function

J'ai essayé votre code, mais je n'ai toujours pas un warning quand j’écris le mot joint dans mon mail et je ne joins pas la pièce jointe. C'est comme si il ne trouve pas le mot joint

**Oliv-** · 19/10/2016, 16h09

Tu aurais du donner la source de ton code on aurait gagné du temps , les derniers commentaires de la discussion
http://www.developpez.net/forums/d12...intes-outlook/

sont tout à fait intéressants !

Voici une version modifiée en conséquence.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'***************************************************************************************
' Auteur      : MinDBuSteR
' Modifié par : Oliv
' Descriptif  : Test si une pièce jointe est présente avant envoi
'***************************************************************************************
    '    Call CheckItemSend(Item, Cancel)
    Dim mail As MailItem
    Dim objAttachments As Attachments
    Dim msg As String
    Dim nbre_pj As Integer
    If Item.Class = olMail Then
        Set mail = Item
        Set objAttachments = Item.Attachments    ' Récupération des pièces jointes
        ' Calcul du nombre de pièces jointes
        nbre_pj = 0
        For i = 1 To objAttachments.Count
            If Not PJ_Isembedded(objAttachments(i)) Then
                nbre_pj = nbre_pj + 1
            End If
        Next i
        Dim MotTrouve As Boolean, MotsCherches
        If (nbre_pj = 0) Then    ' ATTENTION A PARAMETRER EN FONCTION DE LA SIGNATURE QUI OCCUPE 1 PIECE JOINTE
 
           'on ne prend que la partie réponse du mail
            msg = Split(mail.Body, "De*: ", -1, vbTextCompare)(0)
                With New DataObject
        .SetText msg
        .PutInClipboard
 
    End With
 
            'Liste des mots recherchés indiquant la présence éventuelle d'une PJ
            MotsCherches = Array("Joint", "Jointes", "Jointe", "PJ", "attaché")
            MotTrouve = False
            For j = 0 To UBound(MotsCherches) - 1
                MsgBox MotsCherches(j)
                If (ISmotPresentRegex(msg, MotsCherches(j)) = True) Then
                    MotTrouve = True
                    Exit For
                End If
            Next j
            If MotTrouve Then
                If (MsgBox("Il semblerait que vous n'ayez ajouté aucune pièce jointe. Voulez-vous quand même envoyer ce message ?", vbYesNo + vbExclamation + vbDefaultButton2, "Attention") = vbNo) Then
                    Cancel = True
                    Exit Sub
                End If
            End If
        End If
    End If
End sub

avec les fonctions

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
60
61
62
63
64
65
66
67
68
69
70
71
72
Function PJ_Isembedded(ByVal pj As Attachment) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : PJ_Isembedded pour OL2010
' Author    : OLIV-
' Date      : 05/06/2015
' Version   : 3.1
' Purpose   : Indique si une PIECE JOINTE est INCORPOREE dans le Corps du Mail
'---------------------------------------------------------------------------------------
'
    Dim oPA As Outlook.PropertyAccessor
 
    Dim ATTACH_MIME_TAG
    Dim ATTACH_CONTENT_ID
    Dim ATTACHMENT_HIDDEN
    Dim ATTACH_FLAGS
    Dim ATTACH_CONTENT_LOCATION
    Dim ATTACH_METHOD
 
 
    Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
    Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Const PR_ATTACH_FLAGS = "http://schemas.microsoft.com/mapi/proptag/0x37140003"
    Const PR_ATTACH_CONTENT_LOCATION = "http://schemas.microsoft.com/mapi/proptag/0x3713001E"
    Const PR_ATTACH_METHOD = "http://schemas.microsoft.com/mapi/proptag/0x37050003"
 
    Set oPA = pj.PropertyAccessor
 
    On Error Resume Next
    ATTACH_MIME_TAG = oPA.GetProperty(PR_ATTACH_MIME_TAG)
    ATTACHMENT_HIDDEN = oPA.GetProperty(PR_ATTACHMENT_HIDDEN)
    ATTACH_CONTENT_ID = oPA.GetProperty(PR_ATTACH_CONTENT_ID)
    ATTACH_FLAGS = oPA.GetProperty(PR_ATTACH_FLAGS)
    ATTACH_CONTENT_LOCATION = oPA.GetProperty(PR_ATTACH_CONTENT_LOCATION)
    ATTACH_METHOD = oPA.GetProperty(PR_ATTACH_METHOD)
 
    'MsgBox pj & vbCr & "PR_ATTACH_MIME_TAG=" & ATTACH_MIME_TAG _
     & vbCr & "PR_ATTACHMENT_HIDDEN=" & ATTACHMENT_HIDDEN _
     & vbCr _
     & vbCr & "PR_ ATTACH_CONTENT_ID=" & ATTACH_CONTENT_ID _
     & vbCr & "PR_ATTACH_FLAGS=" & ATTACH_FLAGS _
     & vbCr & "PR_ATTACH_CONTENT_LOCATION=" & ATTACH_CONTENT_LOCATION _
     & vbCr & "PR_ATTACH_METHOD=" & ATTACH_METHOD
 
    '  if PR_ATTACH_FLAGS value has the 4 bit set (ATT_MHTML_REF) then
    '              attachment is inline
    '       Else
    '              attachment is normal
    If (ATTACH_CONTENT_ID <> "" And ATTACH_FLAGS = 4) Or ATTACH_METHOD = 6 Or (ATTACH_CONTENT_ID <> "" And InStr(1, pj.Parent.HTMLBody, ATTACH_CONTENT_ID, vbTextCompare) > 0) Then
        PJ_Isembedded = True
    Else
        PJ_Isembedded = False
    End If
 
End Function
 
Function ISmotPresentRegex(Montexte, Mot) As Boolean
 
    Dim objRegex As Object
    Dim objRegM As Object
    Dim MailHeader As String
    Dim ExtractText As String
    Dim i
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        'Prepare a regular expression object
        .Global = True
        .IgnoreCase = True
        .Pattern = "\b" & Mot & "\b"
        ISmotPresentRegex = .test(Montexte)
    End With
End Function

**hajarita65** · 19/10/2016, 16h33

Désolé, pour le code je ne savais pas la source exacte c'est un collègue qui me l'a donnée.

Mais, même avec ce nouveau code, je n'ai toujours pas le warning! Le mot joint ne le trouve pas!

**Oliv-** · 19/10/2016, 17h09

Mets un point d'arrêt au début de la macro !
et utilises le pas à pas pour suivre son déroulement (f8)
--> http://www.developpez.net/forums/blo.../debogage-vba/

**Oliv-** · 20/10/2016, 14h29

est ce que cela marche ?

**chris021** · 26/12/2023, 15h44

Bonjour à tous,

Désolé de déterrer ce sujet très ancien et pour ma question de noob (je ne suis pas programmeur..) mais malgré la présence d'un paramètre "Me prévenir lorsque j'envoie un message pour lequel une pièce jointe semble manquer" dans Outlook ça ne fonctionne pas.
Pourriez-vous SVP m'expliquer comment intégrer ce code dans Outlook ?

Warning si oubli de joindre la piece jointe

Outlook

Discussions similaires

Partager

Partager