none
Moving an email to a user folder RRS feed

  • Question

  • Hello,

    I would like to save and delete the attachments at a mail item while user moves it from one outlook folder to another. I can successfully save the attachments with the following code but it does not delete the attachments. I could not figure out 

    1. how to detect the destination folder that the user selected with the mouse during the move: For the time being (to test the following code) I used a pre-defined and fixed user folder named as "01_SupportTeam"; however this should be dynamic as per the selection of the destination folder by user while moving the mail item with mouse.

    2. how to delete the attachments at the mail item (apparently it losts the reference to the mail item after moving it to the destination folder)

    Could you please help?

    Thanks.

    Public WithEvents colFldItems As Outlook.Items
    Public NS As Outlook.NameSpace

    Private Sub ThisAddIn_Startup() Handles Me.Startup
            NS = Application.GetNamespace("MAPI")
            Dim outFolder As Outlook.MAPIFolder
            outFolder = NS.Folders("xxx@yyy.com").Folders("01_SupportTeam")
            colFldItems = outFolder.Items 
            NS = Nothing
    End Sub

    Private Sub colFldItems_ItemAdd(ByVal pobjMsg As MailItem) Handles colFldtems.ItemAdd
    Dim objAttachments As Outlook.Attachments
    Dim lngCount As int
    Dim strFile As String

    objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count

    If lngCount > 0 Then
      For i = lngCount To 1 Step -1
                    strFile = "c:\Temp\" & objAttachments.Item(i).FileName
                    objAttachments.Item(i).SaveAsFile(strFile)
                    objAttachments.Item(i).Delete()
      next i
    end if

    End Sub


    sahin




    • Edited by orion1 Tuesday, May 29, 2018 9:35 AM
    Tuesday, May 29, 2018 9:26 AM

Answers

  • Hello,

    I solved the issue as the following:

    1. I defined an explorer in ThisAddIn_Startup():

    myOlExp = Application.ActiveExplorer

    it has a definition at the class level for ThisAddIn as the following:

     Public WithEvents myOlExp As Outlook.Explorer

    2. Defined the following sub to get the current folder:

        Private Sub myOlExp_BeforeFolderSwitch(NewFolder As Object, ByRef Cancel As Boolean) Handles myOlExp.BeforeFolderSwitch

            CurFld = GetFolder(NewFolder.FullFolderPath)
        End Sub

    3. GetFolder is the following function:

        Public Function GetFolder(strFolderPath As String) As MAPIFolder
            ' strFolderPath needs to be something like 
            '   "Public Folders\All Public Folders\Company\Sales" or
            '   "Personal Folders\Inbox\My Folder"



            Dim colFolders As Outlook.Folders
            Dim objFolder As Outlook.MAPIFolder
            Dim arrFolders() As String
            Dim I As Long
            On Error Resume Next

            strFolderPath = Replace(strFolderPath, "/", "\")
            arrFolders = Split(strFolderPath, "\")
            ' objApp = Application
            NS = Application.GetNamespace("MAPI")
            objFolder = NS.Folders.Item(arrFolders(2))
            If Not objFolder Is Nothing Then
                For I = 3 To UBound(arrFolders)
                    colFolders = objFolder.Folders
                    objFolder = Nothing
                    objFolder = colFolders.Item(arrFolders(I))
                    If objFolder Is Nothing Then
                        Exit For
                    End If
                Next
            End If

            GetFolder = objFolder
            colFolders = Nothing

            ' objApp = Nothing
        End Function

    4.  I wrote the following sub to detect the destination folder and do my tasks:

        Private Sub DestFld_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, ByRef Cancel As Boolean) Handles CurFld.BeforeItemMove
            'GetDefaultFolder()

            ' MsgBox(NS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderDeletedItems).Name)
            If (MoveTo Is Nothing) Or
            (MoveTo.EntryID = NS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox).EntryID) Or
            (MoveTo.EntryID = NS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderDeletedItems).EntryID) Then
                '   MsgBox(Item.Subject & " was hard deleted")
            Else
                ' MsgBox(MoveTo.Name & " is the destination folder")

                'Do your staff here
            End If

        End Sub

    Thanks.

    sahin.


    sahin

    • Marked as answer by orion1 Monday, June 4, 2018 7:26 AM
    Monday, June 4, 2018 7:25 AM

All replies

  • Hello Sahin,

    1. You need to subscribe to the BeforeItemMove event of the Folder class which is fired when an item is about to be moved or deleted from a folder, either as a result of user action or through program code.

    This event fires when the item is about to be moved to another folder (including the Deleted Items folder) or when the item is about to be permanently deleted. It does not fire during auto-archiving or synchronizing operations.

    If the action is a permanent delete, the  MoveTo folder returned in the event will be Null ( Nothing in Visual Basic).

    2. You can add a user property to the item where you can specify the folder where attachments were saved before removing. That way you will be able to find them every time you need them. See UserProperties.Add for more information. To set for the first time a property created by the  UserProperties.Add method, use the UserProperty.Value property instead of the SetProperties and SetProperty methods of the PropertyAccessor object.


    profile for Eugene Astafiev at Stack Overflow, Q&A for professional and enthusiast programmers

    Wednesday, May 30, 2018 12:46 AM
  • Hello Eugene,

    Thank you very much for your support. I tried your first recommendation and made the changes as you can see in the below code but getting the following errors during compilation:

    "Error BC31029 Method 'DestFld_BeforeItemMove' cannot handle event 'BeforeItemMove' because they do not have a compatible signature."

    I know it is a different error but I could not figure out the reason although I researched a lot. Sorry, I am newby in this and may be asking some very simple questions.

    Public WithEvents colFldItems As Outlook.Items
    Public NS As Outlook.NameSpace
    Public WithEvents DestFld As New Folder

    Private Sub ThisAddIn_Startup() Handles Me.Startup
            NS = Application.GetNamespace("MAPI")
            Dim outFolder As Outlook.MAPIFolder
            outFolder = NS.Folders("xxx@yyy.com").Folders("01_SupportTeam")
            colFldItems = outFolder.Items 
    DestFld = NS.Folders("xxx@yyy.com")
            NS = Nothing
    End Sub

    Private Sub colFldItems_ItemAdd(ByVal pobjMsg As MailItem) Handles colFldtems.ItemAdd
      Dim objAttachments As Outlook.Attachments
      Dim lngCount As int
      Dim strFile As String

      objAttachments = objMsg.Attachments
      lngCount = objAttachments.Count

      If lngCount > 0 Then
        For i = lngCount To 1 Step -1
                    strFile = "c:\Temp\" & objAttachments.Item(i).FileName
                    objAttachments.Item(i).SaveAsFile(strFile)
                    objAttachments.Item(i).Delete()
        next i
      end if
    End Sub

    Private Sub DestFld_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean) Handles DestFld.BeforeItemMove
            If MoveTo Is Nothing Then
                MsgBox(Item.Subject & " was hard deleted")
            Else
                MsgBox(MoveTo.Name & " is the destination folder")

            End If
    End Sub

    Thanks.


    sahin

    Wednesday, May 30, 2018 7:53 AM
  • Hello orion1,

    Private Sub DestFld_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, ByRef Cancel As Boolean) Handles DestFld.BeforeItemMove

    You missed the ByRef statement. Please add it and then test if it could work for you.

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, May 31, 2018 5:44 AM
  • Hello Terry,

    It compiled when I add ByRef. However it refused to upload the addin. It worked when I removed the New in the statement below:

    Public WithEvents DestFld As New Folder

    However, I move emails between folders which are under the root folder (xxx@yyy.com), but it does not recognizes that. It seems it never processes Sub DestFld_BeforeItemMove.

    The final form of the code is as the following:

    Public WithEvents colFldItems As Outlook.Items
    Public NS As Outlook.NameSpace
    Public WithEvents DestFld As Folder

    Private Sub ThisAddIn_Startup() Handles Me.Startup
            NS = Application.GetNamespace("MAPI")
            Dim outFolder As Outlook.MAPIFolder
            outFolder = NS.Folders("xxx@yyy.com").Folders("01_SupportTeam")
            colFldItems = outFolder.Items 
    DestFld = NS.Folders("xxx@yyy.com")
            NS = Nothing
    End Sub

    Private Sub colFldItems_ItemAdd(ByVal pobjMsg As MailItem) Handles colFldtems.ItemAdd
      Dim objAttachments As Outlook.Attachments
      Dim lngCount As int
      Dim strFile As String

      objAttachments = objMsg.Attachments
      lngCount = objAttachments.Count

      If lngCount > 0 Then
        For i = lngCount To 1 Step -1
                    strFile = "c:\Temp\" & objAttachments.Item(i).FileName
                    objAttachments.Item(i).SaveAsFile(strFile)
                    objAttachments.Item(i).Delete()
        next i
      end if
    End Sub

    Private Sub DestFld_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, ByRef Cancel As Boolean) Handles DestFld.BeforeItemMove
            If MoveTo Is Nothing Then
                MsgBox(Item.Subject & " was hard deleted")
            Else
                MsgBox(MoveTo.Name & " is the destination folder")

            End If
    End Sub

    Thanks.

    Sahin.


    sahin


    • Edited by orion1 Thursday, May 31, 2018 5:45 PM
    Thursday, May 31, 2018 7:48 AM
  • Hello,

    I solved the issue as the following:

    1. I defined an explorer in ThisAddIn_Startup():

    myOlExp = Application.ActiveExplorer

    it has a definition at the class level for ThisAddIn as the following:

     Public WithEvents myOlExp As Outlook.Explorer

    2. Defined the following sub to get the current folder:

        Private Sub myOlExp_BeforeFolderSwitch(NewFolder As Object, ByRef Cancel As Boolean) Handles myOlExp.BeforeFolderSwitch

            CurFld = GetFolder(NewFolder.FullFolderPath)
        End Sub

    3. GetFolder is the following function:

        Public Function GetFolder(strFolderPath As String) As MAPIFolder
            ' strFolderPath needs to be something like 
            '   "Public Folders\All Public Folders\Company\Sales" or
            '   "Personal Folders\Inbox\My Folder"



            Dim colFolders As Outlook.Folders
            Dim objFolder As Outlook.MAPIFolder
            Dim arrFolders() As String
            Dim I As Long
            On Error Resume Next

            strFolderPath = Replace(strFolderPath, "/", "\")
            arrFolders = Split(strFolderPath, "\")
            ' objApp = Application
            NS = Application.GetNamespace("MAPI")
            objFolder = NS.Folders.Item(arrFolders(2))
            If Not objFolder Is Nothing Then
                For I = 3 To UBound(arrFolders)
                    colFolders = objFolder.Folders
                    objFolder = Nothing
                    objFolder = colFolders.Item(arrFolders(I))
                    If objFolder Is Nothing Then
                        Exit For
                    End If
                Next
            End If

            GetFolder = objFolder
            colFolders = Nothing

            ' objApp = Nothing
        End Function

    4.  I wrote the following sub to detect the destination folder and do my tasks:

        Private Sub DestFld_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, ByRef Cancel As Boolean) Handles CurFld.BeforeItemMove
            'GetDefaultFolder()

            ' MsgBox(NS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderDeletedItems).Name)
            If (MoveTo Is Nothing) Or
            (MoveTo.EntryID = NS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox).EntryID) Or
            (MoveTo.EntryID = NS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderDeletedItems).EntryID) Then
                '   MsgBox(Item.Subject & " was hard deleted")
            Else
                ' MsgBox(MoveTo.Name & " is the destination folder")

                'Do your staff here
            End If

        End Sub

    Thanks.

    sahin.


    sahin

    • Marked as answer by orion1 Monday, June 4, 2018 7:26 AM
    Monday, June 4, 2018 7:25 AM