VBS script Outlook error

I may have jumped the gun on accepting this solution.

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24324004.html 

When I first tested it, it was on a small scale.  I attempted to run it on account that had 153 unnecessary contacts and it had to be ran several times to delete all of them.  As in first run it would delete 20 or so, next run it would delete 15, etc.  The quantity the script deleted each time was not the same, but none the less it would not delete all of them.

The code is attached and the link above will explain what I was initially looking for.  I need to run this once.
On Error Resume Next
 
Const olFolderContacts = 10
 
strEnding = "@email.com"
 
intLength = Len(strEnding)
 
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
 
Set colContacts = objNamespace.GetDefaultFolder(olFolderContacts).Items
 
For Each objContact In colContacts
    If LCase(Right(objContact.Email1Address, intLength)) = LCase(strEnding) Or _
        LCase(Right(objContact.Email2Address, intLength)) = LCase(strEnding) Or _
        LCase(Right(objContact.Email3Address, intLength)) = LCase(strEnding) Then
            WScript.Echo objContact.FullName
            'objContact.Delete
    End If
Next

Open in new window

LVL 1
NEVAEHSINAsked:
Who is Participating?
 
Chris BottomleyConnect With a Mentor Software Quality Lead EngineerCommented:
imagine thew loop as:

for x = 1 to 15
 delete x
next

When you delete 1 the old 2 becomes the new 1 and so the next item examined is the old three rather than the old 2 ... hopefully you can follow you changed the size of the collection but the index is unchanged

You should use for last item to first item i.e.

Chris
On Error Resume Next
 
Const olFolderContacts = 10
Dim itmCount As Long
 
strEnding = "@email.com"
 
intLength = Len(strEnding)
 
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
 
Set colcontacts = objNamespace.GetDefaultFolder(olFolderContacts).items
 
For itmCount = colcontacts.count To 1 Step -1
Set objContact = colcontacts(itmCount)
'For Each objContact In colContacts
    If LCase(Right(objContact.Email1Address, intLength)) = LCase(strEnding) Or _
        LCase(Right(objContact.Email2Address, intLength)) = LCase(strEnding) Or _
        LCase(Right(objContact.Email3Address, intLength)) = LCase(strEnding) Then
            WScript.Echo objContact.FullName
            'objContact.Delete
    End If
Next

Open in new window

0
 
NEVAEHSINAuthor Commented:
I kind of understand - I'm new to VBS (and appreciate your time).

I'm getting an error (800A0401) in regards to Line: 4, Char: 14 in the above code.  I was probably supposed to edit it before running it.  So, I removed the "As Long" and it worked perfectly and removed all the unnecessary contacts in one sweep.

Hopefully that "As Long" wasn't important :p

0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
Yes sorry, I forgot it was VBS you want and you did it correctly.

Chris
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.