Re: There's gotta be a better way...

1. Move is a function, not a sub - after calling Move, all references to the
old message must be immediately discarded:
set objOlItem = objOlItem.Move(objFolder)
2. OOM always changes ReceivedTime no matter what you do, I could not find
any workarounds. You might want to use Redemption.MAPIUtils object to call
MAPIUtils.getItemFromID() or Redemption.SafeMAPIFolder object.

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


"Barney Mowder" <bmowder@aurora-sys.com> wrote in message
news:d03b7635.0306271345.7d6ab53c@posting.google.com...
> First, I'd like to thank Dmitry Streblechenko for Redemption. REALLY
> nice thing- I can't thank him enough.
>
> I'm trying to do what I'd think was a dirt-simple thing- I'm having my
> users send me their SPAM messages (as attachments, so the header data
> is intact) so I can track what's coming in, and (where appropriate)
> register complaints against the senders.
>
> Typically, I receive an E-Mail message with an attachment which is
> also an e-mail message (the original spam). What I want to do is to
> move the attachment from the e-mail message which contains it into a
> subfolder of my inbox, called "..NEWSPAM".
>
> The only approach I have found so far that works is this kludge of a
> macro.
>
> I am contending with two objections to it.
>
> The first is that whenever I do the CopyTo action, it creates
> another copy of the message in "OutBox", which is why you see the
> nastiness with CollOutBox. I still don't know why the outbox copy is
> created- I thought it would go to "Drafts", which is where the saved
> copy goes before I move it to "..NEWSPAM". I'd like a way to EITHER
> have it create this copy in "..NEWSPAM" so I wouldn't have to move it,
> OR not create it.
>
> The second objection is that that copying the message into a new
> object destroys the original value of 'Mailitem.ReceivedTime'. I'd
> like it if I could actually just COPY or MOVE the attachment into
> "..NEWSPAM" so all the original object data was preserved.
>
> Can any of you guys help? Thanks for your time!
>
> Sub StripSpams()
> Dim objApp As Application
> Dim objSel As Selection
> Dim objFolder As Object
> Dim objOutbox As Object
> Dim collOutBox
> Dim objItem As Object
> Dim objOlItem As Object
> Dim rItem As Object
> Dim eItem As Object
> Dim iIdx0, iIdx1 As Integer
> Dim strFolderPath As String
> Dim strOlHeader, strReHeader As String
> Dim objSubj As String
>
> Set objApp = GetObject(, "Outlook.Application")
> Set objSel = objApp.ActiveExplorer.Selection
> Set objFolder = objApp.Session.GetDefaultFolder(6)
> Set objOutbox = objApp.Session.GetDefaultFolder(4)
>
> 'the subfolder I'm shooting for i.e., inbox/..NEWSPAM
> Set objFolder = objFolder.folders("..NEWSPAM")
>
> Set rItem = CreateObject("Redemption.SafeMailItem")
>
> Set eItem = CreateObject("Redemption.SafeMailItem")
>
> Set objItem = CreateObject("Redemption.SafeMailItem")
>
> For Each objItem In objSel
> objSubj = objItem.Subject
>
> ' Test for subject line match
>
> If (Trim(objSubj) = "junk mail") Then
>
> ' Test for attachments > 0
>
> If (objItem.Attachments.Count) Then
> rItem.Item = objItem
> For iIdx0 = 1 To objItem.Attachments.Count
> Set objOlItem = objApp.CreateItem(0)
> eItem.Item = rItem.Attachments.Item(iIdx0).EmbeddedMsg
> eItem.CopyTo objOlItem
> objOlItem.Save
> EID = objOlItem.EntryID
> Set objOlItem = Nothing
> Set objOlItem = objApp.Session.GetItemFromID(EID)
> objOlItem.Move objFolder
> objOlItem.UnRead = True
> objOlItem.Save
>
> ' The function call below returns the SMTP header of the
> ' message as a string so I can test it against the header of
> ' messages in OutBox.
>
> strOlHeader = GetInternetHeader(objOlItem)
>
> ' Get all the items in OutBox object collection
>
> Set collOutBox = objOutbox.Items
>
> ' This For loop finds the first instance of message which has
an
> ' SMTP header which matches the header of the original
message
> ' And kills it with the .Remove method
>
> For iIdx1 = 1 To collOutBox.Count
> If (GetInternetHeader(objOutbox.Items(iIdx1)) =
strOlHeader) Then
> With objOutbox.Items
> .Remove iIdx1
> End With
> Exit For
> End If
> Next iIdx1
> Set objOlItem = Nothing
> Next iIdx0
> End If
> End If
> objItem.Delete
> Next
>
> Set objOlItem = Nothing
> Set objItem = Nothing
> Set eItem = Nothing
> Set rItem = Nothing
> Set objSel = Nothing
> Set objApp = Nothing
>
> End Sub