Tester le type d'un élément [Résolu]

[myrddin772]

Bonjour à tous,

Voilà, j'ai une routine qui s'éxécute à l'envoi d'un e-mail mais quand j'envoie une demande de réunion, elle foire...

Je ne trouve pas comment tester le type de mon élément pour pouvoir éxécuter ou non la routine du genre :
Si j'envoie un e-mail alors faire tra-la-la
sinon ne rien faire...


Merci d'avance à tous ceux qui pourront m'aider...

[Dolphy35]

Salut,

il serait possible de voire ton code ??

un petit indice Comment exécuter une action en VBA chaque fois que j'envoie un mail ?


Dolphy

[myrddin772]

Merci pour le lien vers les FAQ mais je le savais ça...

Voici un aperçu de mon cade actuel :

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
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.Inspector
Dim objFolder As MAPIFolder
Dim objNS As NameSpace
Dim objItem As Object
Dim Ref_Mail As String
Dim Numero_Mail As String
Dim Path_Folder As String
Dim Réponse As Integer
Dim blnDossier As Boolean
Dim strDialog As String
 
    blnDossier = False
    If (IsNumeric(Left(Item.Subject, 5))) Then
        Set myOlApp = CreateObject("Outlook.Application")
        Ref_Mail = GetNumDossier(myOlApp.Explorers.Item(1).CurrentFolder.Description)
        Path_Folder = GetPathDossier(myOlApp.Explorers.Item(1).CurrentFolder.Description)
        If Left(Ref_Mail, 5) = Left(Item.Subject, 5) Then
            Numero_Mail = CStr(Format((CLng(Right(Ref_Mail, 3)) + 1), "000"))
            Ref_Mail = Left(Ref_Mail, Len(Ref_Mail) - 3) & Numero_Mail
            myOlApp.Explorers.Item(1).CurrentFolder.Description = Ref_Mail & vbCrLf & Path_Folder
            blnDossier = True
        Else
            Réponse = MsgBox("Le dossier sélectionné est différent de celui d'origine du message" & vbCrLf & "Le numéro ne sera pas mis à jour dans le répertoire" _
              & vbCrLf & vbCrLf & "Voulez vous l'envoyer ?" _
              , vbExclamation + vbYesNo, "Attention : Problème mise à jour numéro message")
            If Réponse = vbNo Then Cancel = True
        End If
    End If
    GoTo DéplacementMessage
 
EnvoiSansNumerotation:
    Réponse = MsgBox("Le dossier sélectionné ne comporte pas de champ 'description'" & vbCrLf & "Le numéro ne sera pas mis à jour dans le répertoire" _
      & vbCrLf & vbCrLf & "Voulez vous l'envoyer ?" _
      , vbExclamation + vbYesNo, "Attention : Erreur sur mise à jour numéro message")
    If Réponse = vbNo Then
        Cancel = True
        Exit Sub
    End If
 
DéplacementMessage:
    Set objNS = Application.GetNamespace("MAPI")
    If blnDossier Then
        Set objFolder = myOlApp.Explorers.Item(1).CurrentFolder
    Else
        Set objFolder = objNS.PickFolder
        If TypeName(objFolder) = "Nothing" Then
            Set objFolder = objNS.GetDefaultFolder(olFolderSentMail)
        End If
    End If
    Set Item.SaveSentMessageFolder = objFolder
End Sub

Le problème étant que, si j'nevois une demande de réunion par exemple, la macro affiche une erreur...
Je voudrais donc tester si j'envoie bien un message et pas autre chose... à moins qu'on ne puisse que gérer cela avec une "erreur" du genre :

Code :

1
2
3
4
5
...
...
    On Error Resume Next
    Set Item.SaveSentMessageFolder = objFolder
end sub

[Oliv-]

Bonjour,
Juste au début de ton code dans Application_ItemSend

Code :

1
2
3
4
5
 
If item.Class = olMail Then
' ton code
 
end if

ou comme cela en 1 ligne

Code :

If Not item.Class = olMail Then exit sub

C'est bon ?

[myrddin772]

C'est nickel !

Merci Oliv-

[myrddin772]

a la demande de ucfoutu...

J'ai juste ajouté la ligne qui teste si l'élément est une e-mail pour sortir si ce n'est pas le cas :

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
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.Inspector
Dim objFolder As MAPIFolder
Dim objNS As NameSpace
Dim objItem As Object
Dim Ref_Mail As String
Dim Numero_Mail As String
Dim Path_Folder As String
Dim Réponse As Integer
Dim blnDossier As Boolean
Dim strDialog As String
 
    If Not Item.Class = olMail Then Exit Sub
    blnDossier = False
    If (IsNumeric(Left(Item.Subject, 5))) Then
        Set myOlApp = CreateObject("Outlook.Application")
        Ref_Mail = GetNumDossier(myOlApp.Explorers.Item(1).CurrentFolder.Description)
        Path_Folder = GetPathDossier(myOlApp.Explorers.Item(1).CurrentFolder.Description)
        If Left(Ref_Mail, 5) = Left(Item.Subject, 5) Then
            Numero_Mail = CStr(Format((CLng(Right(Ref_Mail, 3)) + 1), "000"))
            Ref_Mail = Left(Ref_Mail, Len(Ref_Mail) - 3) & Numero_Mail
            myOlApp.Explorers.Item(1).CurrentFolder.Description = Ref_Mail & vbCrLf & Path_Folder
            blnDossier = True
        Else
            Réponse = MsgBox("Le dossier sélectionné est différent de celui d'origine du message" & vbCrLf & "Le numéro ne sera pas mis à jour dans le répertoire" _
              & vbCrLf & vbCrLf & "Voulez vous l'envoyer ?" _
              , vbExclamation + vbYesNo, "Attention : Problème mise à jour numéro message")
            If Réponse = vbNo Then Cancel = True
        End If
    End If
    GoTo DéplacementMessage
 
EnvoiSansNumerotation:
    Réponse = MsgBox("Le dossier sélectionné ne comporte pas de champ 'description'" & vbCrLf & "Le numéro ne sera pas mis à jour dans le répertoire" _
      & vbCrLf & vbCrLf & "Voulez vous l'envoyer ?" _
      , vbExclamation + vbYesNo, "Attention : Erreur sur mise à jour numéro message")
    If Réponse = vbNo Then
        Cancel = True
        Exit Sub
    End If
 
DéplacementMessage:
    Set objNS = Application.GetNamespace("MAPI")
    If blnDossier Then
        Set objFolder = myOlApp.Explorers.Item(1).CurrentFolder
    Else
        Set objFolder = objNS.PickFolder
        If TypeName(objFolder) = "Nothing" Then
            Set objFolder = objNS.GetDefaultFolder(olFolderSentMail)
        End If
    End If
    Set Item.SaveSentMessageFolder = objFolder
End Sub