Hi all,

I have here Outlook XP / 2003 and 2007. I must check some emails for
embedded images. I have found a example code to get the cid over cdo but
it work not completly.

I have the message id from the selected message but I become no resoltes
from the GetMessage.

Can me help someone please. Big big thanks for help.

Best regards,

Tora

Sub check_CID_with_CDO()
Dim itm As Object
Dim objSMail As MAPI.Message
Dim objSAtt As MAPI.Attachment
Dim Obj As Object
Dim objSession As MAPI.Session
Dim strCID As String
On Error Resume Next

Set objSession = CreateObject("MAPI.Session")
objSession.Logon , , False, False
Set itm = GetCurrentItem()
If itm.Class = olMail Then
Set objSMail = CreateObject("MAPI.Message")
strEntryID = itm.EntryID


' <<<---- The object OMsg is empty after 'GetMessage'. Why?????
Set oMsg = objSession.GetMessage(strEntryID)


For Each objSAtt In oMsg.Attachments
' Get the content-ID for the attachment,
' if present. Thanks to Dmitry Streblechenko,
' author of Redemption, for the proptag.
' x3712001f for RTF ????
strCID = objSAtt.Fields(&H3712001E)
If strCID = "" Then
MsgBox "Content-id is Empty, so attachment is not embedded..."
Else
MsgBox "Content-id = " & strCID & _
" So it is embedded..."
End If
strCID = ""
Next
End If

Set objSAtt = Nothing
Set itm = Nothing
End Sub


Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select

Set objApp = Nothing
End Function