Too Many Connections...

[McKilty]

I have a routine outside of Outlook which compares our company contact list against our employee database and deletes from the Contact List whom are no longer employed.

This works properly for awhile, but then I get this error message:

"Your server administrator has limited the number of items you can open simultaneously. Try closing messages you have opened or removing attachments and images from unsent messages you are composing."

It happens on this line: oContact = myFolder.Items.Find("[EMPID2] = " & mlEmp_ID)


The majority of records the oContact will be nothing, so the If Then clause staring with "SafeContact.Item = oContact" is not reached.

There doesn't appear to be a close for the SafeContact, although I don't think that's the issue. How can I make this work?



Private Sub DeleteTerminatedRecipients()

Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim oContact As Outlook.ContactItem
Dim SafeContact As SafeContactItem
Dim Utils As Redemption.IMAPIUtils
Dim bWeCreated As Boolean

Using cnVisExtProd As SqlConnection = New SqlConnection("Data Source=SERVER.com;Initial Catalog=CATALOG;User ID=USERID;Password=PASSWORD")

Try
myOutlook = GetObject(, "Outlook.Application")

Catch ex As Exception
bWeCreated = True
myOutlook = New Outlook.Application

End Try

myNameSpace = myOutlook.GetNamespace("MAPI")
myNameSpace.Logon() ' "ACCOUNT", "PASSWORD", False, False

If UCase(Environ$("Username")) = "MYNAME" Then
myFolder = myNameSpace.Folders("Public Folders - MY EMAIL").Folders("All Public Folders").Folders("Contacts").Folders(gsPublicContactsFolder)
Else
myFolder = myNameSpace.Folders("Public Folders - dlbadmin").Folders("All Public Folders").Folders("Contacts").Folders(gsPublicContactsFolder)
End If


'DELETE EMPLOYEES NO LONGER EMPLOYED
Dim mySQLCommand2 As New SqlCommand("SELECT [Employee], [EMP], [Status], [TerminationDate] FROM [VisionExtendProduction].[dbo].[RecipientsListRemovals] ORDER BY EMP", cnVisExtProd)

mySQLCommand2.Connection.Open()

Dim drAcula As SqlDataReader = mySQLCommand2.ExecuteReader

While drAcula.Read
mlEmp_ID = drAcula.Item("EMP")

SafeContact = CreateObject("Redemption.SafeContactItem") 'Create an instance of Redemption.SafeContactItem
oContact = myFolder.Items.Find("[EMPID2] = " & mlEmp_ID)

If Not oContact Is Nothing Then
SafeContact.Item = oContact
LogChanges(drAcula.Item("NickName").ToString & drAcula.Item("LNAME").ToString, "", "Deleted")
SafeContact.Delete()
miCountOfChanges = miCountOfChanges + 1
oContact.Close(1)

End If

oContact = Nothing
SafeContact = Nothing

End While

drAcula.Close()
drAcula = Nothing
mySQLCommand2.Connection.Close()

If bWeCreated = True Then
myOutlook.Quit()
End If

myFolder = Nothing
myNameSpace = Nothing
myOutlook = Nothing

Utils = CreateObject("Redemption.MAPIUtils")
Utils.Cleanup()
End Using

End Sub

[McKilty]

I forgot to mention that when this fails, I have to close Outlook and I am asked if I want to save multiple items (which I can't see) before closing. That leds me to believe things are being left open.