code to delete all contacts

[MoritzMartin]

Using what I have learned from this group and Sue Mosher's site, I
pieced together code to delete all contacts in a contact folder from
Outlook 2002 on Microsoft Exchange server. The code works good except
it will only delete about half the contacts. I run it again and it
deletes more contacts, and on and on until all the contacts have been
deleted. I want the code to keep running until the contact folder is
empty. Can anyone help me see what I have done wrong? I thank you in
advance. The code follows:

Sub DeleteContact()


Dim myOlApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Dim myContacts As Outlook.Items
Dim myItems As Outlook.Items
Dim myItem As Object
'Set myOlApp = CreateObject("Outlook.Application")
Set myOlApp = Outlook.Application

Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myContacts =
myNamespace.GetDefaultFolder(olFolderContacts).Items
''Set myItems = myContacts.Restrict("[LastModificationTime] >
'01/1/2003'")
Set myItems = myContacts

'Prompt the user for confirmation

strPrompt = "Are you sure you want to delete all the contacts in
the contact folder?"

If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
MsgBox "This may take several minutes. Click OK to begin.",
vbOKOnly

For Each myItem In myItems

If (myItem.Class = olContact) Then
'Debug.Print myItem.Class & "myitem.class"
myItem.Delete
End If
Next
MsgBox ("All contacts have been deleted!")
End If

End Sub

~Thank you, ~BJM

 

[Milly Staples [MVP - Outlook]]

microsoft.public.outlook_vba is where this belongs.

--
Milly Staples [MVP - Outlook]

Post all replies to the group to keep the discussion intact. All
unsolicited mail sent to my personal account will be deleted without
reading.

After furious head scratching, (e-mail address removed) asked:

| Using what I have learned from this group and Sue Mosher's site, I
| pieced together code to delete all contacts in a contact folder from
| Outlook 2002 on Microsoft Exchange server. The code works good except
| it will only delete about half the contacts. I run it again and it
| deletes more contacts, and on and on until all the contacts have been
| deleted. I want the code to keep running until the contact folder is
| empty. Can anyone help me see what I have done wrong? I thank you in
| advance. The code follows:
|
| Sub DeleteContact()
|
|
| Dim myOlApp As Outlook.Application
| Dim myNamespace As Outlook.NameSpace
| Dim myContacts As Outlook.Items
| Dim myItems As Outlook.Items
| Dim myItem As Object
| 'Set myOlApp = CreateObject("Outlook.Application")
| Set myOlApp = Outlook.Application
|
| Set myNamespace = myOlApp.GetNamespace("MAPI")
| Set myContacts =
| myNamespace.GetDefaultFolder(olFolderContacts).Items
| ''Set myItems = myContacts.Restrict("[LastModificationTime] >
| '01/1/2003'")
| Set myItems = myContacts
|
| 'Prompt the user for confirmation
|
| strPrompt = "Are you sure you want to delete all the contacts in
| the contact folder?"
|
| If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
| MsgBox "This may take several minutes. Click OK to begin.",
| vbOKOnly
|
| For Each myItem In myItems
|
| If (myItem.Class = olContact) Then
| 'Debug.Print myItem.Class & "myitem.class"
| myItem.Delete
| End If
| Next
| MsgBox ("All contacts have been deleted!")
| End If
|
| End Sub
|
| ~Thank you, ~BJM