• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 176
  • Last Modified:

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

0
NEVAEHSIN
Asked:
NEVAEHSIN
  • 2
1 Solution
 
Chris BottomleyCommented:
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 BottomleyCommented:
Yes sorry, I forgot it was VBS you want and you did it correctly.

Chris
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now