How do I avoid hitting the limit on simultaneous open items?

  • Thread starter Thread starter bluesbrthr
  • Start date Start date
B

bluesbrthr

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
 
PS - The limit is around 250. I don't wasnt to increase the limit. I want to know how to close my items so I don't come anywhere near the limit.







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
Click to expand...
 
Back
Top