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
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
Bonjour,
13 = incompatibilité de type, tente avec un autre type ?
"ptitemeuh" <ptitemeuh@domain-xyz.in> a écrit dans le message de
news:PumdnRZBu7PWEynW4p2dnAA@giganews.com...
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
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
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
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" <ptitemeuh@domain-xyz.in> a écrit dans le message de news:
PumdnRZBu7PWEynW4p2dnAA@giganews.com...
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
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