Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Erreur d'exécution '13

2 réponses
Avatar
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

2 réponses

Avatar
LE TROLL
Bonjour,

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

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


"ptitemeuh" a écrit dans le message de
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
Avatar
Driss HANIB
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" a écrit dans le message de 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