I can't figure out why the CDO session is hanging on Logoff for the
following code. I've read about the bug he
http://support.microsoft.com/?kbid=177630 I've tried many different
variations but the results are the same. It was running fine using the
Outlook object model but I wanted to Delete without dumping into my Deleted
items or moving it to the journal box deleted items and emptying it
afterwards so I added the CDO bit. I've obviously changed the params for the
DN of the exchange server for this post. I'm running Outlook 2003 sp2 with
Exchange 2003 sp2. Does it make any difference that I'm opening the Journal
mailbox in addition to my mailbox? It hangs if I skip logoff and set
objCDOSession=Nothing too.

Sub ClearInbox_Journal()

On Error GoTo ClearInbox_Error

Dim objItem As MailItem, objItems As Outlook.Items
Dim objItemsRestrict As Outlook.Items
Dim objInboxFolder As Outlook.MAPIFolder
Dim objDeletedFolder As Outlook.MAPIFolder
Dim objCDO As MAPI.Message
Dim objCDOSession As MAPI.Session
Dim sEntryID As String
Dim sStoreID As String
Dim objNS As Outlook.NameSpace
Dim x As Long, i As Long, dCurrent As Date
Dim dDateFilter As Date, sServerDName As String

dCurrent = Now()
dDateFilter = DateAdd("d", -3, dCurrent)

sServerDName =
"/o=MYORG/ou=MYOU/cn=Configuration/cn=Servers/cn=MYSERVER"

Set objNS = Application.GetNamespace("MAPI")
Set objCDOSession = CreateObject("MAPI.Session")
objCDOSession.Logon "", "", False, False, , True, sServerDName & vbLf &
vbLf & "anon"
Set objInboxFolder = objNS.Folders("Mailbox - Journal").Folders("Inbox")
'Set objDeletedFolder = objNS.Folders("Mailbox -
Journal").Folders("Deleted Items")
Set objItems = objInboxFolder.Items
objItems.Sort "[ReceivedTime]", True
Set objItemsRestrict = objItems.Restrict("[ReceivedTime] '" &
Format(dDateFilter, "ddddd h:nn AMPM") & "'")

For x = objItemsRestrict.Count To 1 Step -1
DoEvents
Set objItem = objItemsRestrict.item(x)
If Not objItem Is Nothing Then
sEntryID = objItem.EntryID
sStoreID = objItem.Parent.StoreID
Set objCDO = objCDOSession.GetMessage(sEntryID, sStoreID)
If Not objCDO Is Nothing Then
objCDO.Delete
End If
End If
Next

objCDOSession.Logoff
Set objCDOSession = Nothing
Set objItem = Nothing
Set objItems = Nothing
Set objCDO = Nothing
Set objInboxFolder = Nothing
Set objNS = Nothing

On Error GoTo 0
Exit Sub

ClearInbox_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
" & _
"ClearInbox_Journal"

End Sub


TIA

Matt