Solved: Delete contacts help

[Emjay]

I have the following code. When I run the macro only about half the items get deleted. Any idea why it won't delete all the items?

Sub MD_Test()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim strFolderPath As String
Dim objFolder As Outlook.Folder
Dim objContact As Outlook.ContactItem
Set objOL = Application
Set objNS = objOL.Session
strFolderPath = "<my folder path>"
Set objFolder = GetFolder(strFolderPath)
For Each objContact In objFolder.Items
objContact.Delete
Next
Set objOL = Nothing
Set objNS = Nothing
Set objFolder = Nothing
End Sub

[dougbert]

Hi emjay,

Please mark this thread as 'Solved' by clicking the Thread Tools menu just above your first post if this solution works for you. A nice Rating wouldn't hurt my feelings either. :rotlaugh:

Yes, I do know why only half your contacts get deleted. See my post at: http://www.vbaexpress.com/forum/showthread.php?t=38458 to see how I eventually figured this out. Specifically, in post #3: http://www.vbaexpress.com/forum/showpost.php?p=247714&postcount=3

This is where I figured it out: "After spending some time on MSDN on a page entitled "Working with Members of an Items Collection"": http://msdn.microsoft.com/en-us/library/aa155748(v=office.10).aspx

Essentially, what I learned was the most reliable method for repeating a task on an items list is to start at the bottom and move up. Otherwise, every time you delete something from the top down, Outlook re-orders the list. So, when you delete Item #1, Outlook reorders the entire Items list and Item #2 becomes Item #1 (...maybe), since there isn't an Item #1 after you delete it, #2 becomes #1. So, the old Item #2 (which is now #1) gets skipped in the loop because the loop's moved on to Item #2 (old Item #3?... maybe). Just nod your head if this seems confusing. :think:

Here's how I tested my code below. I created a folder named "Test" (no quotes) under 'My Contacts' in Outlook at the same level as Contacts and Suggested Contacts. I copied 27 of the contacts I had into "Test". I ran the macro and it deleted all of them, which is more than half. :*)

All you should need to do is paste all of the code below into a regular module, change "Test" to your folder's name and compile the code. Should be good to go after that.

Try this:



Option Explicit
Sub MD_Test()
Dim mySession As Outlook.Application, myNS As NameSpace
Dim myContacts As Outlook.MAPIFolder
Dim myFolder As MAPIFolder
Dim myItems As Items
Dim i As Integer
Set mySession = New Outlook.Application
Set myNS = mySession.GetNamespace("MAPI")
Set myContacts = myNS.GetDefaultFolder(olFolderContacts)
Set myFolder = myContacts.Folders("Test")
Set myItems = myFolder.Items

On Error GoTo Release

For i = myItems.Count To 1 Step -1
If TypeName(myFolder.Items.Item(i)) = "ContactItem" Then
myItems.Item(i).Delete
End If
Next i
myItems.Sort "ContactName", False ' This just forces the displayed contacts to refresh.
' Without this, they appear as if they're still there,
' but they're not!
Release:
Set mySession = Nothing
Set myNS = Nothing
Set myContacts = Nothing
Set myFolder = Nothing
Set myItems = Nothing
End Sub


Enjoy!
-dougbert

[Emjay]

Hi emjay,

...

Essentially, what I learned was the most reliable method for repeating a task on an items list is to start at the bottom and move up. Otherwise, every time you delete something from the top down, Outlook re-orders the list. So, when you delete Item #1, Outlook reorders the entire Items list and Item #2 becomes Item #1 (...maybe), since there isn't an Item #1 after you delete it, #2 becomes #1. So, the old Item #2 (which is now #1) gets skipped in the loop because the loop's moved on to Item #2 (old Item #3?... maybe). Just nod your head if this seems confusing. :think:


All you should need to do is paste all of the code below into a regular module, change "Test" to your folder's name and compile the code. Should be good to go after that.

...

Enjoy!
-dougbert

Yes, makes sense. I had to do a little more modification since my contacts folder lives elsewhere, but once completed it works great, thanks. :thumb