Erreur d'exécution '13

Le
ptitemeuh
Bonjour,

Mon programme fonctionnait convenablemenent jusqu'à cette erreur d'exécution '13 que je ne comprends pas du tout

Voici mon 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("Contacts")
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



Lors du débogage, la ligne qui pose problème est : Set UnContact = V

Est-ce que quelqu'un peut m'aider svp ? Merci d'avance
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
LE TROLL
Le #21477891
Bonjour,

13 = incompatibilité de type, tente avec un autre type ?

Cordialement ;o)
-
Logiciels, romans, contacts : http://irolog.free.fr
_______________________
.
.


"ptitemeuh" news:
Bonjour,

Mon programme fonctionnait convenablemenent jusqu'à cette erreur
d'exécution
'13 que je ne comprends pas du tout...

Voici mon 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("Contacts")
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



Lors du débogage, la ligne qui pose problème est : Set UnContact = V

Est-ce que quelqu'un peut m'aider svp ? Merci d'avance
Driss HANIB
Le #21478321
salut ptitemeuh

Comme le TROLL je ne sais pas si ta variable de type ContactItem est capable
d'accepter un variant ?
la strucure ContactItem est complexe

: mets donc : Dim V as ContactItem..

tu devrais pouvoir résoudre ton problème

Drss

Driss

"ptitemeuh"
Bonjour,

Mon programme fonctionnait convenablemenent jusqu'à cette erreur
d'exécution
'13 que je ne comprends pas du tout...

Voici mon 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("Contacts")
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



Lors du débogage, la ligne qui pose problème est : Set UnContact = V

Est-ce que quelqu'un peut m'aider svp ? Merci d'avance
Publicité
Poster une réponse
Anonyme