ADO connection to Access - weird behaviour

V

Vaughan

I really hope someone can help. Many many thanks to anyone who can.

I have some code that copies certain details of items in a public folder
into a table in Access for reporting. I have no training or expertise, and I
created this code largely in the dark after a lot of research (much credit to
Sue's book) and trial and error. But it works (at least until today).

Today, though, it doesn't work. The details for the first 233 items are
copied into the table as expected, but after that the remaining 500 or so
items all show the same details as the 234th (with the exception of the
item's message class, which seems to be correct).

Here is my code if it helps:

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
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.Restrict("[Message
Class]<>""IPM.Post.Meeting_Header""")
For Each objMinItem In objMinItems
Set objCDOItem = GetCDOItemFromOL(objMinItem)
Set objFields = objCDOItem.Fields
Set objFlag = objFields.Item(&H10900003)
Set objFlagText = objFields.Item("0x8530",
"0820060000000000C000000000000046")
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")
arrMinItem(8) = objFlag.Value
arrMinItem(9) = objFlagText.Value
arrMinItem(10) = objMinItem.UserProperties("MeetingThread")
arrMinItem(11) = objMinItem.ConversationTopic
arrMinItem(12) = objMinItem.MessageClass
objADORS.AddNew
For n = 0 To 12
objADORS(n) = arrMinItem(n)
Next n
Next
objADORS.Close
Set objADORS = Nothing
objADOConn.Close
Set objADOConn = Nothing
Set objCDOItem = Nothing
Set objFields = Nothing
Set objFlag = Nothing
Set objFlagText = Nothing
DoCDOLogoff
End Sub
 
V

Vaughan

OK, I have been looking more closely at this,and the problem seems definitely
to be in the use of the Restrict method. Restrict returns a collection of 742
items (which is correct), but from the 250th onwards, the only property (at
least out of the ones I am interested in) that contains anything is
MessageClass.

The items themselves definitely have data in the relevant fields - they are
displayed in any appropriately defined view on the folder.



Vaughan said:
I really hope someone can help. Many many thanks to anyone who can.

I have some code that copies certain details of items in a public folder
into a table in Access for reporting. I have no training or expertise, and I
created this code largely in the dark after a lot of research (much credit to
Sue's book) and trial and error. But it works (at least until today).

Today, though, it doesn't work. The details for the first 233 items are
copied into the table as expected, but after that the remaining 500 or so
items all show the same details as the 234th (with the exception of the
item's message class, which seems to be correct).

Here is my code if it helps:

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
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.Restrict("[Message
Class]<>""IPM.Post.Meeting_Header""")
For Each objMinItem In objMinItems
Set objCDOItem = GetCDOItemFromOL(objMinItem)
Set objFields = objCDOItem.Fields
Set objFlag = objFields.Item(&H10900003)
Set objFlagText = objFields.Item("0x8530",
"0820060000000000C000000000000046")
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")
arrMinItem(8) = objFlag.Value
arrMinItem(9) = objFlagText.Value
arrMinItem(10) = objMinItem.UserProperties("MeetingThread")
arrMinItem(11) = objMinItem.ConversationTopic
arrMinItem(12) = objMinItem.MessageClass
objADORS.AddNew
For n = 0 To 12
objADORS(n) = arrMinItem(n)
Next n
Next
objADORS.Close
Set objADORS = Nothing
objADOConn.Close
Set objADOConn = Nothing
Set objCDOItem = Nothing
Set objFields = Nothing
Set objFlag = Nothing
Set objFlagText = Nothing
DoCDOLogoff
End Sub
Click to expand...
 
C

Chris Fannin

Instead of using Restrict, try using Find:

Set objFolder = GetFolder(strMinFolderPath)
Set objMinItems = objFolder.Items 'Removed Restrict
Set objMinItem = objMinItems.Find("[Message
Class]<>""IPM.Post.Meeting_Header""")
Do While Not objMinItem Is Nothing 'Replaces For Each line
'..the rest of your code here..
Set objMinItem = objMinItems.FindNext
Loop 'Replaces Next

Vaughan said:
I really hope someone can help. Many many thanks to anyone who can.

I have some code that copies certain details of items in a public folder
into a table in Access for reporting. I have no training or expertise, and
I
created this code largely in the dark after a lot of research (much credit
to
Sue's book) and trial and error. But it works (at least until today).

Today, though, it doesn't work. The details for the first 233 items are
copied into the table as expected, but after that the remaining 500 or so
items all show the same details as the 234th (with the exception of the
item's message class, which seems to be correct).

Here is my code if it helps:

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
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.Restrict("[Message
Class]<>""IPM.Post.Meeting_Header""")
For Each objMinItem In objMinItems
Set objCDOItem = GetCDOItemFromOL(objMinItem)
Set objFields = objCDOItem.Fields
Set objFlag = objFields.Item(&H10900003)
Set objFlagText = objFields.Item("0x8530",
"0820060000000000C000000000000046")
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")
arrMinItem(8) = objFlag.Value
arrMinItem(9) = objFlagText.Value
arrMinItem(10) = objMinItem.UserProperties("MeetingThread")
arrMinItem(11) = objMinItem.ConversationTopic
arrMinItem(12) = objMinItem.MessageClass
objADORS.AddNew
For n = 0 To 12
objADORS(n) = arrMinItem(n)
Next n
Next
objADORS.Close
Set objADORS = Nothing
objADOConn.Close
Set objADOConn = Nothing
Set objCDOItem = Nothing
Set objFields = Nothing
Set objFlag = Nothing
Set objFlagText = Nothing
DoCDOLogoff
End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

ADO Connection Problem 4
using ado to query the contents of a spreadsheet 6
getting new button to work with wordmail 1
ADO / Exchange connection Error 1
Saving Emails as Messages Problems with Access Data Collection et 1
How do I create a task from selected email, then move email to arc 0
how to disable Public function macro's 1
Import to Access errors out 19

Top