OLK2K3: CDO and access to item property tags.

Guest · Jan 21, 2005

I have found that I need to use CDO to access the property tags for "custom"
items of post messages. I have read the documentation published at
"http://www.cdolive.com/cdo10.htm", but this doesn't cover accessing custom
property tags. I can determine the "name(s) and Hex Numbers" of the property
tags I need via "Outlookspy".

In my for... next... loop I need to obtain the data for the property tags...
0x8209
0x820A
0x820E
0x8210
0x8211
0x8213
0x8214

How do I accomplish this task?

Code Below...

Option Explicit

'---------------Exporting-----------------

Dim rst
Dim dbe
Dim wks
Dim dbs
Dim nms
Dim fld
Dim itm
Dim itms
Dim objMark1
Dim objProp
Dim objDate
Dim objPage
Dim ItemCount
Dim strKeyDate
Dim MyDate
Dim MyComp
Dim objItem
Dim objNS 'as NameSpace
Dim objFolder 'as MAPIFolder
Dim Namespace
Dim strAccessPath
Dim appAccess
Dim strFolder
Dim strDBEngine
Dim strDBName
Dim fFound

Sub cmdExport_Click()

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder

'Pick up path to Access database directory from Access SysCmd function
Set appAccess = Item.Application.CreateObject("Access.Application")
strAccessPath = appAccess.SysCmd(9)
'Get DAO version from DBEngine
strDBEngine = appAccess.Application.DBEngine.Version
'MsgBox "DBEngine version: " & strDBEngine
appAccess.Quit

If strDBEngine = "3.51" Then
'Office 97 DAO version
Set dbe = Item.Application.CreateObject("DAO.DBEngine.35")
strDBName = strAccessPath & "OSR.mdb"
ElseIf strDBEngine = "3.6" Then
'Office 2000 DAO version
Set dbe = Item.Application.CreateObject("DAO.DBEngine.36")
strDBName = strAccessPath & "OSR.mdb"
Else
MsgBox "Unknown Office version; canceling"
Exit Sub
End If

'MsgBox "DBName: " & strDBName
Set wks = dbe.Workspaces(0)
Set dbs = wks.OpenDatabase(strDBName)

'Open Access table containing contact data
Set rst = dbs.OpenRecordset("tblOSRData")

'Set up reference to Outlook folder of items to export
Set itms = objFolder.Items
ItemCount = itms.Count
If ItemCount = 0 Then
MsgBox "No OSR's to export"
Exit Sub
Else
MsgBox ItemCount & " OSR's to export"
End If
strKeyDate = "1/11/2005"
For Each itm in itms
objDate = Itm.SentOn
MyDate = Left(CStr(objDate),9)
' Msgbox Left(CStr(objDate),9)
MyComp = StrComp(strKeyDate, MyDate, 1)
If MyComp = -1 then
MsgBox "Exporting OLDER Items"
rst.AddNew

'Export the following items if "Assigned To"
rst.AssignedTo = itm.UserProperties("Assigned To")
rst.ClosedBy = itm.UserProperties("Closed By")
rst.DepartmentName = itm.UserProperties("DepartmentName")
rst.DepartmentNumber = itm.UserProperties("DepartmentNumber")
rst.FullName = itm.UserProperties("FullName")
rst.ITComments = itm.UserProperties("MISComments")
stop
Exit For
rst.OSRPriority = itm.UserProperties("Problem Priority")
rst.OSRStatus = itm.UserProperties("Problem Status")
rst.PhoneExtension = itm.UserProperties("Phone Extension")
rst.ProblemDescription = itm.UserProperties("ProblemDescription")
rst.ProductName = itm.UserProperties("Product Name")
rst.ProductVersion = itm.UserProperties("Product Version")
rst.Sent = CStr(itm.SentOn)
rst.TicketID = itm.UserProperties("TicketID")
rst.Update

Else
'MsgBox "Exporting NEWER Items"
'Stop
'Exit For
rst.AddNew

'Export the following items if "AssignedTo"
rst.AssignedTo = itm.UserProperties("AssignedTo")
rst.ClosedBy = itm.UserProperties("ClosedBy")
rst.DepartmentName = itm.UserProperties("DepartmentName")
rst.DepartmentNumber = itm.UserProperties("DepartmentNumber")
rst.FullName = itm.UserProperties("FullName")
rst.ITComments = itm.UserProperties("ITComments")
rst.OSRPriority = itm.UserProperties("OSRPriority")
rst.OSRStatus = itm.UserProperties("OSRStatus")
rst.PhoneExtension = itm.UserProperties("PhoneExtension")
rst.ProblemDescription = itm.UserProperties("ProblemDescription")
rst.ProductName = itm.UserProperties("ProductName")
rst.ProductVersion = itm.UserProperties("ProductVersion")
rst.Sent = CStr(itm.SentOn)
rst.TicketID = itm.UserProperties("TicketID")
rst.Update
End If
Next

rst.Close
MsgBox ItemCount & "All OSR's exported!"

End Sub

Dmitry Streblechenko \(MVP\) · Jan 21, 2005

These are named propeties, instead of passing an integer tag to Fields(),
pass the string that consists of a GUID and id (see
http://www.cdolive.com/cdo10.htm).
The guid and id will shown by OutlokSpy in the "Named Property" box on the
right hand side of the IMessage window when you select a particular property
from the list.
The guid must be munged (again, see http://www.cdolive.com/cdo10.htm).

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Guest · Jan 22, 2005

Thanks, Dmitry!

Does the code below come close to what needs to be done? If I key off the
"itm" in the for each loop (which would be the item I want to look at) and
insert that "itm" in the statement - the error I get is "Object doesn't
support this property or method: 'itm.Item', so I think I need another
object/collection? What are your suggestions? Thanks for the help with
this! <Bill Billmire ->

Option Explicit

'---------------Exporting-----------------

Dim rst
Dim dbe
Dim wks
Dim dbs
Dim nms
Dim fld
Dim itm
Dim itms
Dim objMark1
Dim objProp
Dim objDate
Dim objPage
Dim ItemCount
Dim strKeyDate
Dim MyDate
Dim MyComp
Dim objItem
Dim objNS 'as NameSpace
Dim objFolder 'as MAPIFolder
Dim Namespace
Dim strAccessPath
Dim appAccess
Dim strFolder
Dim strDBEngine
Dim strDBName
Dim fFound

Sub cmdExport_Click()

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder

'Pick up path to Access database directory from Access SysCmd function
Set appAccess = Item.Application.CreateObject("Access.Application")
strAccessPath = appAccess.SysCmd(9)
'Get DAO version from DBEngine
strDBEngine = appAccess.Application.DBEngine.Version
'MsgBox "DBEngine version: " & strDBEngine
appAccess.Quit

If strDBEngine = "3.51" Then
'Office 97 DAO version
Set dbe = Item.Application.CreateObject("DAO.DBEngine.35")
strDBName = strAccessPath & "OSR.mdb"
ElseIf strDBEngine = "3.6" Then
'Office 2000 DAO version
Set dbe = Item.Application.CreateObject("DAO.DBEngine.36")
strDBName = strAccessPath & "OSR.mdb"
Else
MsgBox "Unknown Office version; canceling"
Exit Sub
End If

'MsgBox "DBName: " & strDBName
Set wks = dbe.Workspaces(0)
Set dbs = wks.OpenDatabase(strDBName)

'Open Access table containing contact data
Set rst = dbs.OpenRecordset("tblOSRData")

'Set up reference to Outlook folder of items to export
Set itms = objFolder.Items
ItemCount = itms.Count
If ItemCount = 0 Then
MsgBox "No OSR's to export"
Exit Sub
Else
MsgBox ItemCount & " OSR's to export"
End If
strKeyDate = "1/11/2005"
For Each itm in itms
objDate = Itm.SentOn
MyDate = Left(CStr(objDate),9)
' Msgbox Left(CStr(objDate),9)
MyComp = StrComp(strKeyDate, MyDate, 1)
If MyComp = -1 then
MsgBox "Exporting OLDER Items"
'stop
'Exit For
rst.AddNew

'Export the following items if "Assigned To"
rst.AssignedTo =
itm.Item("{00020329-0000-0000-C000-000000000046}0x8209").Value
rst.ClosedBy =
itm.Item("{00020329-0000-0000-C000-000000000046}0x820A").Value
rst.DepartmentName = itm.UserProperties("DepartmentName")
rst.DepartmentNumber = itm.UserProperties("DepartmentNumber")
rst.FullName = itm.UserProperties("FullName")
rst.ITComments =
itm.Item("{00020329-0000-0000-C000-000000000046}0x820E").Value
rst.OSRPriority =
itm.Item("{00020329-0000-0000-C000-000000000046}0x8210").Value
rst.OSRStatus =
itm.Item("{00020329-0000-0000-C000-000000000046}0x8211").Value
rst.PhoneExtension = itm.UserProperties("PhoneExtension")
rst.ProblemDescription = itm.UserProperties("ProblemDescription")
rst.ProductName =
itm.Item("{00020329-0000-0000-C000-000000000046}0x8213").Value
rst.ProductVersion =
itm.Item("{00020329-0000-0000-C000-000000000046}0x8214").Value
rst.Sent = CStr(itm.SentOn)
rst.TicketID = itm.UserProperties("TicketID")
stop
Exit For
rst.Update

Else

Dmitry Streblechenko \(MVP\) · Jan 22, 2005

Nope. itm is one of the Outlook objects - MailItem, ContactItem etc, but our
discussion applies to the CDO 1.21 messages (MAPI.Message).
You will either need to create an instance of the MAPI.Session object (CDO
1.21 session), then open the message in question using Session.GetMessage
passing itm.EntryID and objFolder.StoreID, then you can use Message.Fields.
Outlook Object Model does not support direct access of the Extended MAPI
propeties the way CDO 1.21 allows that using the Fields collection.
You can also use Redemption (url in my sig.) to associate SafeMailItem with
itm by setting the SafeMailItem.Item property, then access the properties
using SafeMailItem.GetIDsFromNAmes and SafeMailItem.Fields.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

OLK2K3: CDO and access to item property tags.

Guest

Dmitry Streblechenko \(MVP\)

Guest

Dmitry Streblechenko \(MVP\)