vb move msg attachments and delete original emails

Please can somebody help me with a script that can process emails in a folder in Outlook 2010 (x64)

Any email found to have a .msg attachment, move the attachment to the folder and delete the original email.

Thanks
antonio
antoniokingAsked:
Who is Participating?
 
Rgonzo1971Connect With a Mentor Commented:
Hi,

pls try

Sub SaveToFolder()


Dim olApp As Outlook.Application
Dim objNS As Outlook.Namespace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
strSaveFolder = "Your Folder"


    For Each OlItem In myOlItems
    bMsgTrue = False
        If OlItem.Attachments.Count > 0 Then
            For Each ObjAttach In OlItem.Attachments
                If ObjAttach.Type = olEmbeddeditem Then
                    ObjAttach.SaveAsFile strSaveFolder & "\" & ObjAttach.DisplayName
                    Set objAtt = Nothing
                    bMsgTrue = True
                End If
            Next
            If bNMsg = True Then OlItem.Delete
        End If
    Next
        
End Sub

Open in new window

Regards
0
 
antoniokingAuthor Commented:
Hi, thanks for your help.
I actually wanted to save/copy/move the .msg attachments form the email to the same folder within Outlook. Not to a windows directory.

Regards
0
 
Robberbaron (robr)Commented:
I think you need the Redemption addin object to read the .msg and save as an email....
http://www.dimastr.com/redemption/objects.htm

http://www.dimastr.com/redemption/objects.htm#SafeMailItem
Attachment : EmbeddedMsg property
Allows to access embedded message attachments. Returns MessageItem object. For regular (file) attachments this property is NULL
0
 
antoniokingAuthor Commented:
Thanks for this
I saved the attachments to a windows folder then dragged and dropped.

Had to slightly modify the code as some email subjects contained characters windows won't let you name files with.

So here is my replaced code between lines 16-20

                i = i + 1
                If ObjAttach.Type = olEmbeddeditem Then
                    ObjAttach.SaveAsFile strSaveFolder & "\Email-" & i & ".msg"
                    Set objAtt = Nothing
                    bMsgTrue = True
                End If
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.