Delete contacts belonging to a category

[franjorge]

Hello,

I am trying a simple VBA script in order to delete all contacts that
belong to a certain category (TData).

Here is the code


Set miExplorador = Application.ActiveExplorer
Set myNamespace = Application.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderContacts)
If miExplorador.IsFolderSelected(myFolder) = False Then
miExplorador.SelectFolder myFolder
End If

Set fld = Application.ActiveExplorer.CurrentFolder
Set contactos = fld.Items

Set contactosTData = contactos.Restrict("[Categorías] = 'TData'")
numcontactos = contactosTData.Count
Set objContact = contactosTData.GetFirst

Do While Not objContact Is Nothing
Set objCDO = GetCDOItemFromOL(objContact)
If Not objCDO Is Nothing Then
objCDO.Delete
Else
MsgBox ("Contact" & objContact.LastName & " not de deleted")
End If
Set objContact = contactosTData.GetNext
'UserForm1.ProgressBar1 = UserForm1.ProgressBar1 + 1
Loop

I have used CDO in order to avoid the delete confirmation prompt. If I
run this code the while loop takes around 4 minutes to execute.

If instead of deleting the contacts via this script I go to the Outlook
2003 GUI, select the contacts folder, choose the 'By Category' view,
select the 'TData' category and press 'DEL' it takes half of the time
(~2 minutes) to delete the items.

My question is if my code can be optimized anyway so that it does not
take so long to delete all the contacts (there are 1650 contacts in
this category).


Another problem I have is that this code sometimes does not delete some
contacts of the category. If I run the script again, it does delete
them. I tried to catch the records that do not get deleted with the
Msgbox in the else clause, but this does not seem to be the problem.

And finally, not an specific Outlook issue (I think), but the
Progressbar line is commented out, because the UserForm1 shows up as
the code is run, but it does not get updated. In this UserForm I also
have a text label, that is not show, and the Form only shows the 'non
progressing' Progressbar. The background of the form is blank.

Too many questions, but if anyone could answer any of them I would be
very grateful.

Regards,
Fran

 

[Michael Bauer]

Hi Fran,

a) If you´d use CDO also for the loop it would probably take less than
30 seconds.
b) For deleting or moving items from within a loop you´d need to step
backwards or use a While-Wend and reference index(1) as long as the
collection contains data.

--
Viele Grüße
Michael Bauer - MVP Outlook


Hello,

I am trying a simple VBA script in order to delete all contacts that
belong to a certain category (TData).

Here is the code


Set miExplorador = Application.ActiveExplorer
Set myNamespace = Application.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderContacts)
If miExplorador.IsFolderSelected(myFolder) = False Then
miExplorador.SelectFolder myFolder
End If

Set fld = Application.ActiveExplorer.CurrentFolder
Set contactos = fld.Items

Set contactosTData = contactos.Restrict("[Categorías] = 'TData'")
numcontactos = contactosTData.Count
Set objContact = contactosTData.GetFirst

Do While Not objContact Is Nothing
Set objCDO = GetCDOItemFromOL(objContact)
If Not objCDO Is Nothing Then
objCDO.Delete
Else
MsgBox ("Contact" & objContact.LastName & " not de deleted")
End If
Set objContact = contactosTData.GetNext
'UserForm1.ProgressBar1 = UserForm1.ProgressBar1 + 1
Loop

I have used CDO in order to avoid the delete confirmation prompt. If I
run this code the while loop takes around 4 minutes to execute.

If instead of deleting the contacts via this script I go to the Outlook
2003 GUI, select the contacts folder, choose the 'By Category' view,
select the 'TData' category and press 'DEL' it takes half of the time
(~2 minutes) to delete the items.

My question is if my code can be optimized anyway so that it does not
take so long to delete all the contacts (there are 1650 contacts in
this category).


Another problem I have is that this code sometimes does not delete some
contacts of the category. If I run the script again, it does delete
them. I tried to catch the records that do not get deleted with the
Msgbox in the else clause, but this does not seem to be the problem.

And finally, not an specific Outlook issue (I think), but the
Progressbar line is commented out, because the UserForm1 shows up as
the code is run, but it does not get updated. In this UserForm I also
have a text label, that is not show, and the Form only shows the 'non
progressing' Progressbar. The background of the form is blank.

Too many questions, but if anyone could answer any of them I would be
very grateful.

Regards,
Fran

 

[franjorge]

Hallo Michael,

I have tried the following code. I do not know if that is what you
meant by 'using CDO also for the loop', but it takes even more time to
process the records than my original code. What am I doing wrong?

Vielen Dank,
Fran


Dim cdofolder As Folder
Dim cdomessages As Messages
Dim cdoSession As MAPI.Session

Set cdoSession = CreateObject("MAPI.Session")
cdoSession.Logon "", "", False, False

Set cdofolder =
cdoSession.GetDefaultFolder(CdoDefaultFolderContacts)
Set cdomessages = cdofolder.Messages


Set cdoMessage = cdomessages.GetFirst()
Do While Not cdoMessage Is Nothing
categoria = ""
x = cdoMessage.Categories
If IsArray(x) Then
For i = LBound(x) To UBound(x)
categoria = categoria & x(i)
Next
End If

If categoria = "TData" Then
cdoMessage.Delete
End If
Set cdoMessage = cdomessages.GetNext()
Loop

Set objApp = Nothing
Set exlApp = Nothing
Set exlSht = Nothing

 

[Ken Slovak - [MVP - Outlook]]

I'd suggest to speed up things to use a CDO MessageFilter object to reduce
the size of the Messages collection to only items that apply. See
www.cdolive.com/cdo10.htm for the property tags you need to use and
www.cdolive.com/cdo5.htm for CDO code samples. If I recall correctly there
are some there that reference the Categories property.

 

[Michael Bauer]

Hi Fran,

in addition to Ken you could even more speed up the code.

For i = LBound(x) To UBound(x)
categoria = categoria & x(i)
Next

Faster is:
categoria = join(x, ";")

I may be wrong but I suppose there are some logically mistakes in your
sample:

If there really would be an array of categories (i.e. at least two
different values), then I suppose the result in "categoria" wouldn´t be
"TData". Maybe it´s "BusinessTData" or something like that.

That means you can´t compare with the '=' operator, but need the Instr
function.

That in turn means you´d need a delimiter between the different
categories (like in the Join sample above). Otherwise Instr could return
unexpected values. E.g.

x(0)="Advertisement"
x(1)="Data-Private"

In your code "categoria" then would be "AdvertisementData-Private".
Instr would find "tData" in this.

I´m not sure if cdomessages.GetNext() works in this case. Did you try
it?

And, depending on the relation of the amount of filtered items to the
amount of items which have to be deleted there is perhaps another trick
for more speed:

The ForNext loop is the fastest for objects but won´t work if you delete
items. So you could use the ForNext and just collect the objects to be
deleted in a collection. After the ForNext you would then loop through
the collection backwards and delete the objects.