[Déplacé VB6 -- VBA] Erreur d'exécution ' 13' Incompatibilité de type

Question

Bonjour à tous,

J'ai un petit soucis en ce qui concerne mon programme en VBA :s Il me permet d'enregistrer dans la fiche de mes contacts outlook la date du dernier envoi d'un mail à un de mes contacts inscrit dans mon carnet d'adresse. Lorsque j'envoie le mail, la fenêtre d'erreur d'exécution '13' s'affiche... Voici le programme :

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)

Dim Courriel As MailItem
Dim Destinataires As Recipients
Dim Destinataire As Recipient
Dim UnContact As ContactItem
Dim Nb As Integer
Dim Ns As NameSpace
Dim Carnet As MAPIFolder
Dim V As Variant

Set Ns = GetNamespace("MAPI")
Set Carnet = Ns.GetDefaultFolder(olFolderContacts)  'Recherche dans les contacts personnels
'Set Carnet=Ns.GetDefaultFolder(olPublicFoldersAllPublicFolders.folders("Fournisseurs") 'Recherche dans les contacts partagés
Set Courriel = Item
Set Destinataires = Courriel.Recipients


Dim myAddressList As AddressList
Set myAddressList = Application.Session.AddressLists(1)


' ENREGISTREMENT DES CONSULTATIONS DE CHAQUE CONTACT
' Pour tous les destinataires du courriel
For Each Destinataire In Destinataires

    ' Rechercher dans les contacts
    For Each V In Carnet.Items
        If TypeName(V) = "ContactItem" Then
            Set UnContact = V
            If UnContact.Email1Address = Destinataire.Address _
            Or UnContact.Email2Address = Destinataire.Address _
            Or UnContact.Email3Address = Destinataire.Address Then
                ' Destinataire trouvé
                If UnContact.Body = "" Then
                    ' Ajouter la première consultation dans Notes du contact
                    UnContact.Body = "1.  " & Format(Now(), "dddddd") & "   -  De " & Courriel.Session.CurrentUser.Name & "   -  Objet :  " & Courriel.Subject
                    UnContact.Save
                    Else
                        ' Ajouter la dernière consultation à la liste dans Notes du contact
                        UnContact.Body = UBound(Split(UnContact.Body, ".  ")) + 1 & ".  " & Format(Now(), "dddddd") & "   -  De " & Courriel.Session.CurrentUser.Name & "   -  Objet :  " & Courriel.Subject & vbCrLf & UnContact.Body
                        UnContact.Save
                End If

    Exit For
            End If
        End If

        Next V
        Next Destinataire

End Sub





L'erreur se situe à ligne 
Set UnContact = V

Je ne connais pas du tout cette erreur étant donné que je suis débutante dans le VB et je ne comprends pas d'où viendrait l'erreur... Pouvez-vous m'aider svp ?

cs_Jack · Answer

Salut
Je ne connais pas ces objets, mais tu peux essayer de dimensionner V As Object.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

ptitemeuh · Answer

Bonjour,

Merci pour ta réponse, j'ai changé variant  en object  mais rien ne se produit non plus... Mais je pense d'où vient la faute car avant tout fonctionnait correctement. C'est depuis que je partage mes contacts avec deux autres personnes qu'elle apparaît, c'est ça qui doit poser problème mais je ne sais pas comment régler le problème...

cs_Jack · Answer

Au fait, pourquoi veux-tu transférer un objet sur un autre ?
Pourquoi ne pas utiliser V directement au lieu de UnContact ?

ptitemeuh · Answer

Bonjour,

En fait, je voudrais enregistrer la date ainsi que l'objet du mail envoyé dans les notes du contact auquel j'ai envoyé un mail.

J'ai changer la dimension de V en utilisant :

V As ContactItem

Mais vu que pour For Each il faut un Next avec une variante ou un objet, ça coince ce coup là à Next V... J'ai également essayé de mettre mettre:

V As Variant

Mais j'ai une autre Erreur d'exécution 4096 "Un ou plusieurs éléments dans le dossier que vous avez synchronisé ne correspondent pas. Pour résoudre les conflits, ouvrez les éléments, puis renouvelez l'opération". Elle est située à :

           If V.Email1Address = Destinataire.Address _
            Or V.Email2Address = Destinataire.Address _
            Or V.Email3Address = Destinataire.Address Then

Pas facile à cerner le problème...

cs_Jack · Answer

Bon, à tête reposée, j'ai fait un essai simple et je n'ai pas eu de difficulté :
    Dim Ns As NameSpace
    Dim Carnet As MAPIFolder
    Dim V As Variant
    
    Set Ns = GetNamespace("MAPI")
    Set Carnet = Ns.GetDefaultFolder(olFolderContacts)

    For Each V In Carnet.Items
        If TypeName(V) = "ContactItem" Then
            Debug.Print V, V.Email1Address, V.Email2Address, V.Email3Address
        End If
    Next
Il y a bien quelque chose dans Destinataire.Address ?
Cette erreur 4096 ressemble plus à un problème d'organisation internet de Outlook que de programmation. Bizarre. Ton carnet d'adresse est-il ouvert au moment de l'erreur ?
Sur quel Item apparait l'erreur ?
Cet Item a t-il qqchose de particulier ?

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

ptitemeuh · Answer

Bonjour,

J'ai supprimé tout à l'intérieur de ma boucle
For Each Destinataire In Destinataires

    ' Rechercher dans les contacts
    For Each V In Carnet.Items
        If TypeName(V) = "ContactItem" Then
            'Set UnContact = V
            Debug.Print V, V.Email1Address, V.Email2Address, V.Email3Address
            If V.Email1Address = Destinataire.Address _
            Or V.Email2Address = Destinataire.Address _
            Or V.Email3Address = Destinataire.Address Then
                ' Destinataire trouvé
                If UnContact.Body = "" Then
                    ' Ajouter la première consultation dans Notes du contact
                    V.Body = "1.  " & Format(Now(), "dddddd") & "   -  De " & Courriel.Session.CurrentUser.Name & "   -  Objet :  " & Courriel.Subject
                    V.Save
                    Else
                         'Ajouter la dernière consultation à la liste dans Notes du contact
                        V.Body = UBound(Split(V.Body, ".  ")) + 1 & ".  " & Format(Now(), "dddddd") & "   -  De " & Courriel.Session.CurrentUser.Name & "   -  Objet :  " & Courriel.Subject & vbCrLf & V.Body
                        V.Save
                End If

    Exit For
            End If
        End If

        Next V
        Next Destinataire

End Sub

Par ce que tu m'as dit:

Debug.Print V, V.Email1Address, V.Email2Address, V.Email3Address


Il n'y a aucune erreur... J'ai essayé un tas de changements, peut-être que je m'y prend mal je ne sais pas mais il y a toujours une erreur qui coince...

Concernant Destinataire.Adresse il y a bien quelque chose. Et mon carnet d'adresse est ouvert puisque je suis outlook, mais depuis quelques temps, il est partagé avec deux autres personnes, je ne sais pas si on doit en tenir compte...

Mon erreur se bloque sur :

           If V.Email1Address = Destinataire.Address _
            Or V.Email2Address = Destinataire.Address _
            Or V.Email3Address = Destinataire.Address Then

J'ai beau modifier, je ne sais vraiment pas comment je peux procéder...

ptitemeuh · Answer

Mais apparemment, c'est la boucle For Each V In Carnet.Items qui doit poser problème car si je la met en commentaire, il n'y aucune erreur, mais mon petit bout de programme ne fonctionne pas puisque l'on ne parcours pas tout le carnet d'adresses. Existe-t-il une autre instruction de ce type ?

[Déplacé VB6 --> VBA] Erreur d'exécution ' 13' Incompatibilité de type

7 réponses

Votre réponse

Discussions similaires