Trying to Use Redemption to copy msg attachments to inbox

[Aaron]

I am trying to use VBA in Outlook to copy an attached msg file in an email to
a folder and then delete the original email. I am currently working to just
get the attached msg file to move to the proper folder. I have downloaded
and installed Redemption in order to do this as suggested on other boards. I
thought my code was close to what other people have (modified for my use),
but it doesn’t seem to work. Please let me know what I need to change for
this. Thank you.

Public Sub CopyAttachment(myMailItem As Outlook.MailItem)

Dim NS As Outlook.NameSpace
Dim olkFolderset As Outlook.Folders
Dim olkFolder As Outlook.Folder
Dim olkAttachedMSG, olkMailItem, olkNewMailItem As Outlook.MailItem
Dim redAttachment, redMailItem As Object
Dim strID As String

strID = myMailItem.EntryID
Set NS = Outlook.GetNamespace("MAPI")
Set olkFolder = NS.OpenSharedFolder("ITCS (POP)\Inbox")
Set olkMailItem = NS.GetItemFromID(strID)
Set redMailItem = CreateObject("Redemption.SafeMailItem")
redMailItem.item = olkMailItem
Set redAttachment = redMailItem.Attachment
Set olkAttachedMSG = redAttachment.EmbeddedMsg
Set olkNewMailItem = Outlook.CreateItem(olMailItem)
olkAttachedMSG.CopyTo (olkNewMailItem)
olkNewMailItem.Save
olkNewMailItem.Move (olkFolder)

End Sub

 

[Dmitry Streblechenko]

What exactly does not work?
Do you get an error? Or it simply produces an unexpected result?

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