> 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