Re: Restrict method problem

Tech-Archive recommends: Speed Up your PC by fixing your registry

Sadly, Sue, the situation is still the same.

Reworked code is as follows. I would be eternally grateful for some more
help with this.

Sub TransferMinutesToAccess()
On Error Resume Next

Dim objADOConn As Object
Dim objADORS As Object
Dim objMinItem As Object
Dim objMinItems As Outlook.Items
Dim objFolder As Object
Dim arrMinItem(12) As Variant
Dim objFlag As Object
Dim objFlagText As Object
strMinFolderPath = "Public Folders\All Public Folders\Projects\Project
Details\Minutes"
Set objADOConn = New ADODB.Connection
objADOConn.Open "DSN=ProjectPacks"
Set objADORS = New ADODB.RecordSet
With objADORS
.Open "Select * From tbl_ExchangeMinutes", objADOConn, adOpenStatic,
adLockOptimistic
If Not .BOF Then
.MoveFirst
While Not .EOF
.Delete
.MoveNext
Wend
End If
End With

DoCDOLogon
Set objFolder = GetFolder(strMinFolderPath)
Set objMinItems = objFolder.Items
Set objMinItem = objMinItems.Find("[Message Class] <>
""IPM.Post.Meeting_Header""")
Do While Not objMinItem Is Nothing
Set objCDOItem = GetCDOItemFromOL(objMinItem)
Set objFields = objCDOItem.Fields
arrMinItem(1) = objMinItem.UserProperties("Meeting Description")
arrMinItem(2) = objMinItem.UserProperties("Job")
arrMinItem(3) = objMinItem.UserProperties("MeetingDate")
arrMinItem(4) = objMinItem.Body
arrMinItem(5) = objMinItem.ConversationIndex
arrMinItem(6) = objMinItem.UserProperties("AssignedTo")
arrMinItem(7) = objMinItem.UserProperties("DueDate")
Set objFlag = objFields.Item(&H10900003)
If Err.Number <> 0 Then
arrMinItem(8) = 1000
Err.Clear
Else
arrMinItem(8) = objFlag.Value
End If
Set objFlagText = objFields.Item("0x8530",
"0820060000000000C000000000000046")
If Err.Number <> 0 Then
arrMinItem(9) = ""
Err.Clear
Else
arrMinItem(9) = objFlagText.Value
End If
arrMinItem(10) = objMinItem.UserProperties("MeetingThread")
arrMinItem(11) = objMinItem.ConversationTopic
arrMinItem(12) = objMinItem.MessageClass
objADORS.AddNew
For n = 1 To 12
objADORS(n) = arrMinItem(n)
Set arrMinItem(n) = Nothing
Next n
objADORS.Update

Set objNewRec = Nothing
Set objFlag = Nothing
Set objFlagText = Nothing
Set objFields = Nothing
Set objCDOItem = Nothing
Set GetCDOItemFromOL(objMinItem) = Nothing
Set objMinItem = Nothing

Set objMinItem = objMinItems.FindNext
Loop

objADORS.Close
Set objADORS = Nothing
objADOConn.Close
Set objADOConn = Nothing
Set objFields = Nothing
DoCDOLogoff
End Sub


"Vaughan" wrote:

> Many thanks Sue, I'll give these a try.
>
> Vaughan
>
> "Sue Mosher [MVP-Outlook]" wrote:
>
> > Try using Find instead of Restrict and in the example below, use objMinItems.GetFirst and GetNext instead of a For Each loop, setting objMinItem and objCDOItem to Nothing before reusing them. I'm not sure that will do the trick, but it's the logical thing to try.
> > --
> > Sue Mosher, Outlook MVP
> > Author of
> > Microsoft Outlook Programming - Jumpstart for
> > Administrators, Power Users, and Developers
> > http://www.outlookcode.com/jumpstart.aspx
> >
> >
> > "Vaughan" <Vaughan@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:19744F19-459D-4035-B749-97704F5D189A@xxxxxxxxxxxxxxxx
> > > Thanks for your patience Sue.
> > >
> > > I am using Outlook VBA v 6.2. My code is as follows:
> > >
> > > Sub TransferMinutesToAccess()
> > > On Error Resume Next
> > > Dim objADOConn As Object
> > > Dim objADORS As Object
> > > Dim objMinItem As Object
> > > Dim objMinItems As Outlook.Items
> > > Dim objFolder As Object
> > > Dim arrMinItem(12) As Variant
> > > Dim dtmMinItem As Date
> > > Dim intUniqueNo As Integer
> > > Dim objFlag As Object
> > > Dim objFlagText As Object
> > > strMinFolderPath = "Public Folders\All Public Folders\Projects\Project _
> > > Details\Minutes"
> > > Set objADOConn = New ADODB.Connection
> > > Set objADORS = New ADODB.RecordSet
> > > objADOConn.Open "DSN=ProjectPacks"
> > > With objADORS
> > > .Open "Select * From tbl_ExchangeMinutes", objADOConn, adOpenStatic, _
> > > adLockOptimistic
> > > If Not .BOF Then
> > > .MoveFirst
> > > While Not .EOF
> > > .Delete
> > > .MoveNext
> > > Wend
> > > End If
> > > End With
> > > DoCDOLogon
> > > Set objFolder = GetFolder(strMinFolderPath)
> > > Set objMinItems = objFolder.Items
> > > For Each objMinItem In objMinItems
> > > If objMinItem.MessageClass <> "IPM.Post.Meeting_Header" Then
> > > Set objCDOItem = GetCDOItemFromOL(objMinItem)
> > > Set objFields = objCDOItem.Fields
> > > arrMinItem(1) = objMinItem.UserProperties("Meeting Description")
> > > arrMinItem(2) = objMinItem.UserProperties("Job")
> > > arrMinItem(3) = objMinItem.UserProperties("MeetingDate")
> > > arrMinItem(4) = objMinItem.Body
> > > arrMinItem(5) = objMinItem.ConversationIndex
> > > arrMinItem(6) = objMinItem.UserProperties("AssignedTo")
> > > arrMinItem(7) = objMinItem.UserProperties("DueDate")
> > > Set objFlag = objFields.Item(&H10900003)
> > > If Err.Number <> 0 Then
> > > arrMinItem(8) = 1000
> > > Err.Clear
> > > Else
> > > arrMinItem(8) = objFlag.Value
> > > End If
> > > Set objFlagText = objFields.Item _("0x8530",
> > > "0820060000000000C000000000000046")
> > > If Err.Number <> 0 Then
> > > arrMinItem(9) = ""
> > > Err.Clear
> > > Else
> > > arrMinItem(9) = objFlagText.Value
> > > End If
> > > arrMinItem(10) = objMinItem.UserProperties("MeetingThread")
> > > arrMinItem(11) = objMinItem.ConversationTopic
> > > arrMinItem(12) = objMinItem.MessageClass
> > > Set objNewRec = objADORS.AddNew
> > > For n = 1 To 12
> > > objADORS(n) = arrMinItem(n)
> > > Set arrMinItem(n) = Nothing
> > > Next n
> > > End If
> > > objADORS.Update
> > > Set objNewRec = Nothing
> > > Set objFlag = Nothing
> > > Set objFlagText = Nothing
> > > Set objFields = Nothing
> > > Set objCDOItem = Nothing
> > > Set objMinItem = Nothing
> > > Set GetCDOItemFromOL(objMinItem) = Nothing
> > > Next
> > > objADORS.Close
> > > Set objADORS = Nothing
> > > objADOConn.Close
> > > Set objADOConn = Nothing
> > > Set objFields = Nothing
> > > DoCDOLogoff
> > > Exit Sub
> > > End Sub
> > >
> > > "Sue Mosher [MVP-Outlook]" wrote:
> > >
> > >> In what programming language?
> > >>
> > >> --
> > >> Sue Mosher, Outlook MVP
> > >> Author of
> > >> Microsoft Outlook Programming - Jumpstart for
> > >> Administrators, Power Users, and Developers
> > >> http://www.outlookcode.com/jumpstart.aspx
> > >>
> > >>
> > >> "Vaughan" <Vaughan@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:96074E2A-3C2B-46DE-8AC5-5E5A828A9859@xxxxxxxxxxxxxxxx
> > >> > Sorry Sue. Yes OL2003 and Exchange2003.
> > >> >
> > >> > Sounds promising. How do I dereference the item object variables?
> > >> >
> > >> > "Sue Mosher [MVP-Outlook]" wrote:
> > >> >
> > >> >> You didn't mention the Outlook version or mail configuration or coding environment, but it sounds like you're running Outlook 2003 against an Exchange and running up against the limit on open RPC channels. Make sure you dereference item object variables as you use them. If you're using VS.NET, you'll need to perform garbage collection periodically.
> > >>
> > >> >>
> > >> >> "Vaughan" <Vaughan@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:76081BF2-59EE-497C-B029-970FAC802705@xxxxxxxxxxxxxxxx
> > >> >> >I am using the restrict method to return a collection of the items in a
> > >> >> > public folder. Only the first 249 items returned appear to contain any data,
> > >> >> > anything after that is just a heap of nothing. Is this a limit on Restrict's
> > >> >> > functionality?
> > >> >>
> > >>
> >
.

Relevant Pages