Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Outlook Outlook 2000 VBA Supprimer les contacts d'une catégorie

Outlook 2000 VBA Supprimer les contacts d'une catégorie

17 réponses
Avatar
Céline Brien
Bonjour à tous et à toutes,
Quelqu'un peut-il me refiler les codes VBA pour supprimer tous les
contacts appartenant à une catégorie ?
Merci de votre aide,
Céline
Signaler un problème avec ce contenu

7 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Céline Brien
Bonjour à toutes et à tous,
Bonjour Anor,
Bonjour Grég,
J'ai finalement réussi ! Voir mes codes VBA ci-dessous.
Voici aussi une copie du dernier message de Ken Slovak qui m'a beaucoup
aidée.
Merci encore de votre aide,
Céline
------------------------------------------------
Message de Ken
------------------------------------------------
You need to instantiate the contact item in the loop. As it is the
object is
not assigned to anything.
For i = Items.Count To 1 Step -1
Set OlContact = Items(i)
If InStr(1, OlContact.Categories, "Excel") Then
OlContact.Delete
End If
Next
It's also not a good idea to use an object or collection name that is
the
same as the object or collection itself if only because it's confusing.
Dim colItems As Outlook.Items
or
Dim oItems As Outlook.Items
and so on
Using the code as it is might also be a problem if the Items collection
also
holds distribution list items. Assigning a ContactItem object to a DL
item
causes an error. With no error handler your code would just stop. If you
use
On Error Resume Next the If test following the assignment would fail. So
either make OlContact an Object and use late binding if you also want to
include DL's or test for either the .Class (= olContact) or that the
.MessageClass string property includes "IPM.Contact" in it before
assigning
to a ContactItem variable.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm
------------------------------------------------
Mes codes VBA
------------------------------------------------
Sub DeleteOutlookContactsExcel()
Dim StrContacts As String
Dim olApp As New Outlook.Application
Dim olMapi As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim colItems As Outlook.Items
Dim olContact As Outlook.ContactItem
Dim i As Long
Set olMapi = olApp.GetNamespace("MAPI")
Set olFolder = olMapi.GetDefaultFolder(olFolderContacts)
Set colItems = olFolder.Items
For i = colItems.Count To 1 Step -1
Set colContact = colItems(i)
If InStr(1, colContact.Categories, "Excel") Then
colContact.Delete
End If
Next
MsgBox StrContacts
Set olContact = Nothing
Set colItems = Nothing
Set olFolder = Nothing
Set olMapi = Nothing
Set olApp = Nothing
End Sub
---------------------------------------------------
fin de ce message du 15 avril
---------------------------------------------------
"Grég" a écrit dans le message de
news:
Bonjour/soir,

"Anor" <http://memoaccess.free.fr/anor/email.htm> a écrit dans le
message de

news:407d8c47$0$22851$
Bonjour,

Grég wrote:
| Bonjour/soir,
|
| En effet, utiliser un for each pour faire du nettoyage dans une
| collection n'est pas propre du tout.

la notion de propreté est subjective pour un autodidacte,
mais cela peut effectivement se défendre....

Je ne savais pas qu'un autodidacte était moins sujet qu'un autre à la

propreté !-) Mais un programme qui a des effets de bords celà peut
"salire"

la mémoire à des endroits inattendus !


| A part ça il y a deux autre problèmes dont l'un est que le
| "compilateur" de vba est un ###CENSURE###, pas même capable de
| vérifier que l'on utilise une constante comme nom de variable.
| 1/ olContact est une constante
| 2/ Votre variable OlContact pouvait être autre chose qu'un objet
| Outlook.ContactItem d'où l'erreur de type.

En tout cas, là, je dois avouer que c'est parfaitement bien vu ;-)
je n'ai plus qu'à corriger toutes mes déclarations pour les noms
d'objets


outlook :-(

En enlevant quelques voyelles (ou en utilisant du français) on évite
généralement les conflits de ce type.

...


--
Grég





Avatar
Anor
Bonjour Céline


Céline Brien wrote:
| Bonjour à toutes et à tous,
| Bonjour Anor,
| Bonjour Grég,
| J'ai finalement réussi ! Voir mes codes VBA ci-dessous.
| Voici aussi une copie du dernier message de Ken Slovak qui m'a
| beaucoup aidée.
| Merci encore de votre aide,
| Céline

En dessous de
Option Compare Database,
rajoute
Option Explicit

Ainsi, le code ne devrait plus compiler car
tu déclares toujours Dim olContact
et tu affectes Set colContact.
<CODE>
Sub DeleteOutlookContactsExcel()
Dim StrContacts As String
Dim olApp As New Outlook.Application
Dim olMapi As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim colItems As Outlook.Items
Dim olContact As Outlook.ContactItem
Dim i As Long
Set olMapi = olApp.GetNamespace("MAPI")
Set olFolder = olMapi.GetDefaultFolder(olFolderContacts)
Set colItems = olFolder.Items
For i = colItems.Count To 1 Step -1
Set colContact = colItems(i)
If InStr(1, colContact.Categories, "Excel") Then
colContact.Delete
End If
Next
MsgBox StrContacts
Set olContact = Nothing
Set colItems = Nothing
Set olFolder = Nothing
Set olMapi = Nothing
Set olApp = Nothing
End Sub
</CODE>


c'est étonnant que ça fonctionne ainsi en
mélangeant les "Object" et les "Variant".
Comme OlFolder, OlContact sont aussi des constantes,
le monsieur t'a dit qu'il valait mieux donner un autre nom :

OL_App, Ol_Mapi, Ol_Folder ou
oApp, oMapi, oFolder
semblent préférables.

Voilà, cette-fois-ci, ça devrait être "propre",
que l'on connaisse toutes les constantes vba
par coeur ou pas
;-)

--
à+
Arnaud
--------------------------------------------------
Access Memorandum : http://memoaccess.free.fr
/Réponses souhaitées sur ce forum, merci/
--------------------------------------------------
Avatar
Céline Brien
Bonjour à toutes et à tous,
Salut Arnaud,
Merci pour ce complément.
Tu trouveras mes codes modifiées ci-dessous.
J'ai ajouté Option Explicit en haut de la ligne Sub comme en VBA Excel.
J'obtiens maintenant un message d'erreur sur la ligne suivante :
Set ol_Contact = ol_Items(i)
Le message est :
Erreur d'exécution 13. Incompatibilité de type.
Quelqu'un peut m'aider ?
Merci,
Céline
-------------------------------------------------------------
Option Explicit
Sub DeleteOutlookContactsExcel()
Dim StrContacts As String
Dim ol_App As New Outlook.Application
Dim ol_Mapi As Outlook.NameSpace
Dim ol_Folder As Outlook.MAPIFolder
Dim ol_Items As Outlook.Items
Dim ol_Contact As Outlook.ContactItem
Dim i As Long
Set ol_Mapi = ol_App.GetNamespace("MAPI")
Set ol_Folder = ol_Mapi.GetDefaultFolder(olFolderContacts)
Set ol_Items = ol_Folder.Items
For i = ol_Items.Count To 1 Step -1
Set ol_Contact = ol_Items(i)
If InStr(1, ol_Contact.Categories, "Excel") Then
ol_Contact.Delete
End If
Next
MsgBox StrContacts
Set ol_Contact = Nothing
Set ol_Items = Nothing
Set ol_Folder = Nothing
Set ol_Mapi = Nothing
Set ol_App = Nothing
End Sub
-------------------------------------------------------------
fin codes
-------------------------------------------------------------

"Anor" <http://memoaccess.free.fr/anor/email.htm> a écrit dans le
message de news:407ef9b1$0$17618$
Bonjour Céline


Céline Brien wrote:
| Bonjour à toutes et à tous,
| Bonjour Anor,
| Bonjour Grég,
| J'ai finalement réussi ! Voir mes codes VBA ci-dessous.
| Voici aussi une copie du dernier message de Ken Slovak qui m'a
| beaucoup aidée.
| Merci encore de votre aide,
| Céline

En dessous de
Option Compare Database,
rajoute
Option Explicit

Ainsi, le code ne devrait plus compiler car
tu déclares toujours Dim olContact
et tu affectes Set colContact.
<CODE>
Sub DeleteOutlookContactsExcel()
Dim StrContacts As String
Dim olApp As New Outlook.Application
Dim olMapi As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim colItems As Outlook.Items
Dim olContact As Outlook.ContactItem
Dim i As Long
Set olMapi = olApp.GetNamespace("MAPI")
Set olFolder = olMapi.GetDefaultFolder(olFolderContacts)
Set colItems = olFolder.Items
For i = colItems.Count To 1 Step -1
Set colContact = colItems(i)
If InStr(1, colContact.Categories, "Excel") Then
colContact.Delete
End If
Next
MsgBox StrContacts
Set olContact = Nothing
Set colItems = Nothing
Set olFolder = Nothing
Set olMapi = Nothing
Set olApp = Nothing
End Sub
</CODE>


c'est étonnant que ça fonctionne ainsi en
mélangeant les "Object" et les "Variant".
Comme OlFolder, OlContact sont aussi des constantes,
le monsieur t'a dit qu'il valait mieux donner un autre nom :

OL_App, Ol_Mapi, Ol_Folder ou
oApp, oMapi, oFolder
semblent préférables.

Voilà, cette-fois-ci, ça devrait être "propre",
que l'on connaisse toutes les constantes vba
par coeur ou pas
;-)

--
à+
Arnaud
--------------------------------------------------
Access Memorandum : http://memoaccess.free.fr
/Réponses souhaitées sur ce forum, merci/
--------------------------------------------------





Avatar
Grég
Céline,

Il ne vous plaisait pas mon code?
Remontez un peu et ma réponse 2 vous donne la cause de l'erreur. Le test
supplémentaire, permet de ne supprimer que les Contacts (pas les listes).
Les Or permettent de gérer les catégories multiples sans retenir celles du
type *Excel*.

--
Grég


"Céline Brien" a écrit dans le message de
news:
Bonjour à toutes et à tous,
Salut Arnaud,
Merci pour ce complément.
Tu trouveras mes codes modifiées ci-dessous.
J'ai ajouté Option Explicit en haut de la ligne Sub comme en VBA Excel.
J'obtiens maintenant un message d'erreur sur la ligne suivante :
Set ol_Contact = ol_Items(i)
Le message est :
Erreur d'exécution 13. Incompatibilité de type.
Quelqu'un peut m'aider ?
Merci,
Céline
-------------------------------------------------------------
Option Explicit
Sub DeleteOutlookContactsExcel()
Dim StrContacts As String
Dim ol_App As New Outlook.Application
Dim ol_Mapi As Outlook.NameSpace
Dim ol_Folder As Outlook.MAPIFolder
Dim ol_Items As Outlook.Items
Dim ol_Contact As Outlook.ContactItem
Dim i As Long
Set ol_Mapi = ol_App.GetNamespace("MAPI")
Set ol_Folder = ol_Mapi.GetDefaultFolder(olFolderContacts)
Set ol_Items = ol_Folder.Items
For i = ol_Items.Count To 1 Step -1
Set ol_Contact = ol_Items(i)
If InStr(1, ol_Contact.Categories, "Excel") Then
ol_Contact.Delete
End If
Next
MsgBox StrContacts
Set ol_Contact = Nothing
Set ol_Items = Nothing
Set ol_Folder = Nothing
Set ol_Mapi = Nothing
Set ol_App = Nothing
End Sub
-------------------------------------------------------------
fin codes
-------------------------------------------------------------

"Anor" <http://memoaccess.free.fr/anor/email.htm> a écrit dans le
message de news:407ef9b1$0$17618$
Bonjour Céline


Céline Brien wrote:
| Bonjour à toutes et à tous,
| Bonjour Anor,
| Bonjour Grég,
| J'ai finalement réussi ! Voir mes codes VBA ci-dessous.
| Voici aussi une copie du dernier message de Ken Slovak qui m'a
| beaucoup aidée.
| Merci encore de votre aide,
| Céline

En dessous de
Option Compare Database,
rajoute
Option Explicit

Ainsi, le code ne devrait plus compiler car
tu déclares toujours Dim olContact
et tu affectes Set colContact.
<CODE>
Sub DeleteOutlookContactsExcel()
Dim StrContacts As String
Dim olApp As New Outlook.Application
Dim olMapi As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim colItems As Outlook.Items
Dim olContact As Outlook.ContactItem
Dim i As Long
Set olMapi = olApp.GetNamespace("MAPI")
Set olFolder = olMapi.GetDefaultFolder(olFolderContacts)
Set colItems = olFolder.Items
For i = colItems.Count To 1 Step -1
Set colContact = colItems(i)
If InStr(1, colContact.Categories, "Excel") Then
colContact.Delete
End If
Next
MsgBox StrContacts
Set olContact = Nothing
Set colItems = Nothing
Set olFolder = Nothing
Set olMapi = Nothing
Set olApp = Nothing
End Sub
</CODE>


c'est étonnant que ça fonctionne ainsi en
mélangeant les "Object" et les "Variant".
Comme OlFolder, OlContact sont aussi des constantes,
le monsieur t'a dit qu'il valait mieux donner un autre nom :

OL_App, Ol_Mapi, Ol_Folder ou
oApp, oMapi, oFolder
semblent préférables.

Voilà, cette-fois-ci, ça devrait être "propre",
que l'on connaisse toutes les constantes vba
par coeur ou pas
;-)

--
à+
Arnaud
--------------------------------------------------
Access Memorandum : http://memoaccess.free.fr
/Réponses souhaitées sur ce forum, merci/
--------------------------------------------------








Avatar
Céline Brien
Bonjour à toutes et à tous,
Salut Grég,
Je devais être très fatiquée lorsque j'ai lu ta réponse.
Effectivement, tes codes fonctionnent très très bien !
Merci beaucoup, beaucoup.
Tu trouveras ci-dessous l'ensemble des codes que je vais utiliser :
1) Des codes pour supprimer les contacts de la catégorie Excel.
2) Des codes pour importer des contacts d'un fichier Excel.
Des utilisateurs sur différents ordinateurs, utiliseront ce fichier
Excel pour partager des contacts.
Merci encore,
Céline
----------------------------------------------------------------
1) Des codes pour supprimer les contacts de la catégorie Excel.
----------------------------------------------------------------
Option Explicit
Sub DeleteOutlookContacts()

' On Error Resume Next
Dim StrContacts As String
Dim OlApp As New Outlook.Application
Dim OlMapi As Outlook.NameSpace
Dim OlFolder As Outlook.MAPIFolder
Dim OlItems As Outlook.Items
Dim OlContactItm As Object
Dim LgI As Long
Set OlMapi = OlApp.GetNamespace("MAPI")
Set OlFolder = OlMapi.GetDefaultFolder(olFolderContacts)
Set OlItems = OlFolder.Items
For LgI = OlItems.Count To 1 Step -1
Set OlContactItm = OlItems(LgI)
If OlContactItm.Class = olContact Then
If OlContactItm.Categories = "Excel" Or InStr(1,
OlContactItm.Categories, "; Excel") Or _
InStr(1, OlContactItm.Categories, "Excel;") Then
OlContactItm.Delete
End If
End If
Next LgI
MsgBox StrContacts
Set OlContactItm = Nothing
Set OlItems = Nothing
Set OlFolder = Nothing
Set OlMapi = Nothing
Set OlApp = Nothing
Call ContactsExcelToOutlook
End Sub
---------------------------------------------------------
2) Des codes pour importer des contacts d'un fichier Excel.
---------------------------------------------------------
Sub ContactsExcelToOutlook()
'
' Macro pour importer des contacts d'un fichier Excel
' Macro extraite du livre de Sue Mosher et améliorée avec l'aide de
Ken Slovak
'
Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim objRange As Excel.Range
Dim objApp As Outlook.Application
Dim objContact As Outlook.ContactItem
Dim intRowCount As Integer
Dim i As Integer
On Error Resume Next

m_blnWeOpenedExcel = False
Set objExcel = GetObject(, "Excel.Application")
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
m_blnWeOpenedExcel = True
End If
On Error GoTo 0
Set objWB = objExcel.Workbooks.Add("C:Documents and SettingsCéline
BrienMes documentsOutlook 2000Contacts en Excel.xls")
Set objWS = objWB.Worksheets(1)
Set objRange = objWS.Range("Data")
intRowCount = objRange.Rows.Count
If intRowCount > 0 Then
Set objApp = CreateObject("Outlook.Application")
For i = 2 To intRowCount
Set objContact = objApp.CreateItem(olContactItem)
With objContact
.FirstName = objRange.Cells(i, 2)
.LastName = objRange.Cells(i, 3)
.CompanyName = objRange.Cells(i, 4)
.JobTitle = objRange.Cells(i, 5)
.BusinessAddressStreet = objRange.Cells(i, 6)
.BusinessAddressCity = objRange.Cells(i, 7)
.BusinessAddressState = objRange.Cells(i, 8)
.BusinessAddressPostalCode = objRange.Cells(i, 9)
.BusinessAddressState = objRange.Cells(i, 10)
.BusinessTelephoneNumber = objRange.Cells(i, 11)
.BusinessFaxNumber = objRange.Cells(i, 12)
.Email1Address = objRange.Cells(i, 13)
.Body = objRange.Cells(i, 14)
.Categories = objRange.Cells(i, 15)
.Save
End With
Next
End If
objWB.Close False
Call RestoreExcel

Set objExcel = Nothing
Set objWB = Nothing
Set objWS = Nothing
Set objRange = Nothing
Set objApp = Nothing
Set objContact = Nothing
MsgBox "Les contacts Excel ont été mis à jour"
End Sub
Sub RestoreExcel()
Dim objExcel As Excel.Application
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If m_blnWeOpenedExcel Then
objExcel.Quit
Else
objExcel.Visible = True
End If
Set objExcel = Nothing
End Sub
---------------------------------------------------------------------
fin des codes
---------------------------------------------------------------------
"Grég" a écrit dans le message de
news:407f1505$0$17591$
Céline,

Il ne vous plaisait pas mon code?
Remontez un peu et ma réponse 2 vous donne la cause de l'erreur. Le
test

supplémentaire, permet de ne supprimer que les Contacts (pas les
listes).

Les Or permettent de gérer les catégories multiples sans retenir
celles du

type *Excel*.

--
Grég


"Céline Brien" a écrit dans le message
de

news:
Bonjour à toutes et à tous,
Salut Arnaud,
Merci pour ce complément.
Tu trouveras mes codes modifiées ci-dessous.
J'ai ajouté Option Explicit en haut de la ligne Sub comme en VBA
Excel.


J'obtiens maintenant un message d'erreur sur la ligne suivante :
Set ol_Contact = ol_Items(i)
Le message est :
Erreur d'exécution 13. Incompatibilité de type.
Quelqu'un peut m'aider ?
Merci,
Céline
-------------------------------------------------------------
Option Explicit
Sub DeleteOutlookContactsExcel()
Dim StrContacts As String
Dim ol_App As New Outlook.Application
Dim ol_Mapi As Outlook.NameSpace
Dim ol_Folder As Outlook.MAPIFolder
Dim ol_Items As Outlook.Items
Dim ol_Contact As Outlook.ContactItem
Dim i As Long
Set ol_Mapi = ol_App.GetNamespace("MAPI")
Set ol_Folder = ol_Mapi.GetDefaultFolder(olFolderContacts)
Set ol_Items = ol_Folder.Items
For i = ol_Items.Count To 1 Step -1
Set ol_Contact = ol_Items(i)
If InStr(1, ol_Contact.Categories, "Excel") Then
ol_Contact.Delete
End If
Next
MsgBox StrContacts
Set ol_Contact = Nothing
Set ol_Items = Nothing
Set ol_Folder = Nothing
Set ol_Mapi = Nothing
Set ol_App = Nothing
End Sub
-------------------------------------------------------------
fin codes
-------------------------------------------------------------




Avatar
Grég
Bonjour/soir,

Vous auriez pu répondre que mon code ne vous plaisait pas, je ne me serait
pas vexé: j'ai laissé vos noms de variables qui peuvent être source de
(futurs) problèmes comme indiqué par Anor et Ken Slovak !-)

Juste un vieux réflexe, je vous conseille de déclarer en constante le nom et
le chemin de votre fichier Excel. Le jour où vous voudrez les rendre plus
variables, la maintenance sera plus aisée. De plus, cela aide généralement à
l'optimisation du code.

--
Grég


"Céline Brien" a écrit dans le message de
news:%
Bonjour à toutes et à tous,
Salut Grég,
Je devais être très fatiquée lorsque j'ai lu ta réponse.
Effectivement, tes codes fonctionnent très très bien !
Merci beaucoup, beaucoup.
Tu trouveras ci-dessous l'ensemble des codes que je vais utiliser :
1) Des codes pour supprimer les contacts de la catégorie Excel.
2) Des codes pour importer des contacts d'un fichier Excel.
Des utilisateurs sur différents ordinateurs, utiliseront ce fichier
Excel pour partager des contacts.
Merci encore,
Céline
----------------------------------------------------------------
1) Des codes pour supprimer les contacts de la catégorie Excel.
----------------------------------------------------------------
Option Explicit
Sub DeleteOutlookContacts()

' On Error Resume Next
Dim StrContacts As String
Dim OlApp As New Outlook.Application
Dim OlMapi As Outlook.NameSpace
Dim OlFolder As Outlook.MAPIFolder
Dim OlItems As Outlook.Items
Dim OlContactItm As Object
Dim LgI As Long
Set OlMapi = OlApp.GetNamespace("MAPI")
Set OlFolder = OlMapi.GetDefaultFolder(olFolderContacts)
Set OlItems = OlFolder.Items
For LgI = OlItems.Count To 1 Step -1
Set OlContactItm = OlItems(LgI)
If OlContactItm.Class = olContact Then
If OlContactItm.Categories = "Excel" Or InStr(1,
OlContactItm.Categories, "; Excel") Or _
InStr(1, OlContactItm.Categories, "Excel;") Then
OlContactItm.Delete
End If
End If
Next LgI
MsgBox StrContacts
Set OlContactItm = Nothing
Set OlItems = Nothing
Set OlFolder = Nothing
Set OlMapi = Nothing
Set OlApp = Nothing
Call ContactsExcelToOutlook
End Sub
---------------------------------------------------------
2) Des codes pour importer des contacts d'un fichier Excel.
---------------------------------------------------------
Sub ContactsExcelToOutlook()
'
' Macro pour importer des contacts d'un fichier Excel
' Macro extraite du livre de Sue Mosher et améliorée avec l'aide de
Ken Slovak
'
Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim objRange As Excel.Range
Dim objApp As Outlook.Application
Dim objContact As Outlook.ContactItem
Dim intRowCount As Integer
Dim i As Integer
On Error Resume Next

m_blnWeOpenedExcel = False
Set objExcel = GetObject(, "Excel.Application")
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
m_blnWeOpenedExcel = True
End If
On Error GoTo 0
Set objWB = objExcel.Workbooks.Add("C:Documents and SettingsCéline
BrienMes documentsOutlook 2000Contacts en Excel.xls")
Set objWS = objWB.Worksheets(1)
Set objRange = objWS.Range("Data")
intRowCount = objRange.Rows.Count
If intRowCount > 0 Then
Set objApp = CreateObject("Outlook.Application")
For i = 2 To intRowCount
Set objContact = objApp.CreateItem(olContactItem)
With objContact
.FirstName = objRange.Cells(i, 2)
.LastName = objRange.Cells(i, 3)
.CompanyName = objRange.Cells(i, 4)
.JobTitle = objRange.Cells(i, 5)
.BusinessAddressStreet = objRange.Cells(i, 6)
.BusinessAddressCity = objRange.Cells(i, 7)
.BusinessAddressState = objRange.Cells(i, 8)
.BusinessAddressPostalCode = objRange.Cells(i, 9)
.BusinessAddressState = objRange.Cells(i, 10)
.BusinessTelephoneNumber = objRange.Cells(i, 11)
.BusinessFaxNumber = objRange.Cells(i, 12)
.Email1Address = objRange.Cells(i, 13)
.Body = objRange.Cells(i, 14)
.Categories = objRange.Cells(i, 15)
.Save
End With
Next
End If
objWB.Close False
Call RestoreExcel

Set objExcel = Nothing
Set objWB = Nothing
Set objWS = Nothing
Set objRange = Nothing
Set objApp = Nothing
Set objContact = Nothing
MsgBox "Les contacts Excel ont été mis à jour"
End Sub
Sub RestoreExcel()
Dim objExcel As Excel.Application
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If m_blnWeOpenedExcel Then
objExcel.Quit
Else
objExcel.Visible = True
End If
Set objExcel = Nothing
End Sub
---------------------------------------------------------------------
fin des codes
---------------------------------------------------------------------
"Grég" a écrit dans le message de
news:407f1505$0$17591$
Céline,

Il ne vous plaisait pas mon code?
Remontez un peu et ma réponse 2 vous donne la cause de l'erreur. Le
test

supplémentaire, permet de ne supprimer que les Contacts (pas les
listes).

Les Or permettent de gérer les catégories multiples sans retenir
celles du

type *Excel*.

--
Grég


"Céline Brien" a écrit dans le message
de

news:
Bonjour à toutes et à tous,
Salut Arnaud,
Merci pour ce complément.
Tu trouveras mes codes modifiées ci-dessous.
J'ai ajouté Option Explicit en haut de la ligne Sub comme en VBA
Excel.


J'obtiens maintenant un message d'erreur sur la ligne suivante :
Set ol_Contact = ol_Items(i)
Le message est :
Erreur d'exécution 13. Incompatibilité de type.
Quelqu'un peut m'aider ?
Merci,
Céline
-------------------------------------------------------------
Option Explicit
Sub DeleteOutlookContactsExcel()
Dim StrContacts As String
Dim ol_App As New Outlook.Application
Dim ol_Mapi As Outlook.NameSpace
Dim ol_Folder As Outlook.MAPIFolder
Dim ol_Items As Outlook.Items
Dim ol_Contact As Outlook.ContactItem
Dim i As Long
Set ol_Mapi = ol_App.GetNamespace("MAPI")
Set ol_Folder = ol_Mapi.GetDefaultFolder(olFolderContacts)
Set ol_Items = ol_Folder.Items
For i = ol_Items.Count To 1 Step -1
Set ol_Contact = ol_Items(i)
If InStr(1, ol_Contact.Categories, "Excel") Then
ol_Contact.Delete
End If
Next
MsgBox StrContacts
Set ol_Contact = Nothing
Set ol_Items = Nothing
Set ol_Folder = Nothing
Set ol_Mapi = Nothing
Set ol_App = Nothing
End Sub
-------------------------------------------------------------
fin codes
-------------------------------------------------------------







Avatar
Céline Brien
Bonjour à toutes et à tous,
Salut Grég,
Merci encore pour ta réponse.
Je vais revoir les noms des variables.
Je vais aussi déclarer en constance le nom et le chemin de mon fichier
Excel.
Merci pour ces précieux conseils !
Céline

"Grég" a écrit dans le message de
news:
Bonjour/soir,

Vous auriez pu répondre que mon code ne vous plaisait pas, je ne me
serait

pas vexé: j'ai laissé vos noms de variables qui peuvent être source de
(futurs) problèmes comme indiqué par Anor et Ken Slovak !-)

Juste un vieux réflexe, je vous conseille de déclarer en constante le
nom et

le chemin de votre fichier Excel. Le jour où vous voudrez les rendre
plus

variables, la maintenance sera plus aisée. De plus, cela aide
généralement à

l'optimisation du code.

--
Grég


"Céline Brien" a écrit dans le message
de

news:%
Bonjour à toutes et à tous,
Salut Grég,
Je devais être très fatiquée lorsque j'ai lu ta réponse.
Effectivement, tes codes fonctionnent très très bien !
Merci beaucoup, beaucoup.
Tu trouveras ci-dessous l'ensemble des codes que je vais utiliser :
1) Des codes pour supprimer les contacts de la catégorie Excel.
2) Des codes pour importer des contacts d'un fichier Excel.
Des utilisateurs sur différents ordinateurs, utiliseront ce fichier
Excel pour partager des contacts.
Merci encore,
Céline
----------------------------------------------------------------
1) Des codes pour supprimer les contacts de la catégorie Excel.
----------------------------------------------------------------
Option Explicit
Sub DeleteOutlookContacts()

' On Error Resume Next
Dim StrContacts As String
Dim OlApp As New Outlook.Application
Dim OlMapi As Outlook.NameSpace
Dim OlFolder As Outlook.MAPIFolder
Dim OlItems As Outlook.Items
Dim OlContactItm As Object
Dim LgI As Long
Set OlMapi = OlApp.GetNamespace("MAPI")
Set OlFolder = OlMapi.GetDefaultFolder(olFolderContacts)
Set OlItems = OlFolder.Items
For LgI = OlItems.Count To 1 Step -1
Set OlContactItm = OlItems(LgI)
If OlContactItm.Class = olContact Then
If OlContactItm.Categories = "Excel" Or InStr(1,
OlContactItm.Categories, "; Excel") Or _
InStr(1, OlContactItm.Categories, "Excel;") Then
OlContactItm.Delete
End If
End If
Next LgI
MsgBox StrContacts
Set OlContactItm = Nothing
Set OlItems = Nothing
Set OlFolder = Nothing
Set OlMapi = Nothing
Set OlApp = Nothing
Call ContactsExcelToOutlook
End Sub
---------------------------------------------------------
2) Des codes pour importer des contacts d'un fichier Excel.
---------------------------------------------------------
Sub ContactsExcelToOutlook()
'
' Macro pour importer des contacts d'un fichier Excel
' Macro extraite du livre de Sue Mosher et améliorée avec l'aide
de


Ken Slovak
'
Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim objRange As Excel.Range
Dim objApp As Outlook.Application
Dim objContact As Outlook.ContactItem
Dim intRowCount As Integer
Dim i As Integer
On Error Resume Next

m_blnWeOpenedExcel = False
Set objExcel = GetObject(, "Excel.Application")
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
m_blnWeOpenedExcel = True
End If
On Error GoTo 0
Set objWB = objExcel.Workbooks.Add("C:Documents and
SettingsCéline


BrienMes documentsOutlook 2000Contacts en Excel.xls")
Set objWS = objWB.Worksheets(1)
Set objRange = objWS.Range("Data")
intRowCount = objRange.Rows.Count
If intRowCount > 0 Then
Set objApp = CreateObject("Outlook.Application")
For i = 2 To intRowCount
Set objContact = objApp.CreateItem(olContactItem)
With objContact
.FirstName = objRange.Cells(i, 2)
.LastName = objRange.Cells(i, 3)
.CompanyName = objRange.Cells(i, 4)
.JobTitle = objRange.Cells(i, 5)
.BusinessAddressStreet = objRange.Cells(i, 6)
.BusinessAddressCity = objRange.Cells(i, 7)
.BusinessAddressState = objRange.Cells(i, 8)
.BusinessAddressPostalCode = objRange.Cells(i, 9)
.BusinessAddressState = objRange.Cells(i, 10)
.BusinessTelephoneNumber = objRange.Cells(i, 11)
.BusinessFaxNumber = objRange.Cells(i, 12)
.Email1Address = objRange.Cells(i, 13)
.Body = objRange.Cells(i, 14)
.Categories = objRange.Cells(i, 15)
.Save
End With
Next
End If
objWB.Close False
Call RestoreExcel

Set objExcel = Nothing
Set objWB = Nothing
Set objWS = Nothing
Set objRange = Nothing
Set objApp = Nothing
Set objContact = Nothing
MsgBox "Les contacts Excel ont été mis à jour"
End Sub
Sub RestoreExcel()
Dim objExcel As Excel.Application
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If m_blnWeOpenedExcel Then
objExcel.Quit
Else
objExcel.Visible = True
End If
Set objExcel = Nothing
End Sub


---------------------------------------------------------------------
fin des codes


---------------------------------------------------------------------
"Grég" a écrit dans le message de
news:407f1505$0$17591$
Céline,

Il ne vous plaisait pas mon code?
Remontez un peu et ma réponse 2 vous donne la cause de l'erreur.
Le



test
supplémentaire, permet de ne supprimer que les Contacts (pas les
listes).

Les Or permettent de gérer les catégories multiples sans retenir
celles du

type *Excel*.

--
Grég


"Céline Brien" a écrit dans le
message



de
news:
Bonjour à toutes et à tous,
Salut Arnaud,
Merci pour ce complément.
Tu trouveras mes codes modifiées ci-dessous.
J'ai ajouté Option Explicit en haut de la ligne Sub comme en VBA
Excel.


J'obtiens maintenant un message d'erreur sur la ligne suivante :
Set ol_Contact = ol_Items(i)
Le message est :
Erreur d'exécution 13. Incompatibilité de type.
Quelqu'un peut m'aider ?
Merci,
Céline
-------------------------------------------------------------
Option Explicit
Sub DeleteOutlookContactsExcel()
Dim StrContacts As String
Dim ol_App As New Outlook.Application
Dim ol_Mapi As Outlook.NameSpace
Dim ol_Folder As Outlook.MAPIFolder
Dim ol_Items As Outlook.Items
Dim ol_Contact As Outlook.ContactItem
Dim i As Long
Set ol_Mapi = ol_App.GetNamespace("MAPI")
Set ol_Folder = ol_Mapi.GetDefaultFolder(olFolderContacts)
Set ol_Items = ol_Folder.Items
For i = ol_Items.Count To 1 Step -1
Set ol_Contact = ol_Items(i)
If InStr(1, ol_Contact.Categories, "Excel") Then
ol_Contact.Delete
End If
Next
MsgBox StrContacts
Set ol_Contact = Nothing
Set ol_Items = Nothing
Set ol_Folder = Nothing
Set ol_Mapi = Nothing
Set ol_App = Nothing
End Sub
-------------------------------------------------------------
fin codes
-------------------------------------------------------------










1 2