Moving email to another Folder after saving attachment



  • I am trying to move an email after saving the attachment to a server folder. I added code (commented out) to try to move the email itself to another subfolder in my inbox. It is not working. Anyone see what I am missing?

    Private WithEvents Items As Outlook.Items

    Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items

    End Sub

    Private Sub Items_ItemAdd(ByVal item As Object)

    On Error GoTo ErrorHandler

    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
    Set Msg = item

    'Set folder to save in.
    Dim olDestFldr As Outlook.MAPIFolder
    Dim myAttachments As Outlook.Attachments

    'location to save in. Can be root drive or mapped network drive.
    Const attPath As String = "T:\Daily Report Raw Data"
    Const attPath2 As String = "T:\Programmatic Deal Raw Data"

    'Change variables to match need. Comment or delete any part unnecessary.
    If (Msg.SenderEmailAddress = "[email protected]") And _
    (Msg.Subject = "Last 7 Day House Ads") And _
    (Msg.Attachments.Count >= 1) Then
    'save attachment
    Set myAttachments = item.Attachments
    myAttachments.item(1).SaveAsFile attPath & "\Daily House Ads.xls"
    'mark as read
    Msg.UnRead = False
    'move email
    'Set olDestFldr = objNS.Folders("DFPHouse")
    'item.Move olDestFldr
    'Msg.Move SubFolder
    End If

    There is more code looking for other criteria, but this is the first step and the same code can be applied moving forward.


  • administrators

    hi @cturley I think the issue is in the line Set olDestFldr = objNS.Folders("DFPHouse")

    Folder cannot be set in that way. You have to use one of the getFolder methods.

    Here's some sample code I wrote to move one item from default folder to customfolder

    Sub outlooktest()
    Dim olApp As New Outlook.Application, objNS As Outlook.Namespace, items As Outlook.items, item As Outlook.MailItem, singlefolder As Outlook.Folder, testfolders As Outlook.Folders
    Dim destFolder As Outlook.Folder, destfolderId As String
    Set objNS = olApp.GetNamespace("MAPI")
    Set items = objNS.GetDefaultFolder(olFolderInbox).items
    Set item = items.GetFirst
    destfolderId = getfolderId("customfolder")
    Set destFolder = objNS.GetFolderFromID(destfolderId)
    item.Move destFolder
    End Sub
    
    
    Function getfolderId(foldername)
    Dim olApp As New Outlook.Application, objNS As Outlook.Namespace, mainfolder As Outlook.Folder, subfolders As Outlook.Folders, singlefolder As Outlook.Folder
    Set objNS = olApp.GetNamespace("MAPI")
    Set mainfolder = objNS.Folders.GetFirst
    Set subfolders = mainfolder.Folders
    For Each singlefolder In subfolders
    If singlefolder.name = foldername Then
    getfolderId = singlefolder.EntryID
    End If
    Next
    End Function
    

    Usually custom folders get created inside the main folder so I wrote above function to look for subfolders in the main folder. Modify it if your folder hierarchy is different. Let me know if that helps.



  • @ranjithkumar10 I incorporated the code into my existing code. I am getting a compile error, method ir data member not found. It is reacting to the items as outlook.items line. Here is the code I am testing.

    Private WithEvents Items As Outlook.Items

    Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set objNS = olApp.GetNamespace("MAPI")
    Set Items = Outlook.Item
    Set Item = Outlook.MailItem
    singlefolder As Outlook.Folder
    testfolders As Outlook.Folder
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items

    End Sub

    Private Sub Items_ItemAdd(ByVal Item As Object)

    On Error GoTo ErrorHandler

    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(Item) = "MailItem" Then
    Set Msg = Item

    'Set folder to save in.
    Dim destfldr As Outlook.Folder
    destfoldrId As String
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Item
    Set Item = Items.GetFirst
    destfoldrId = getfolderId("customfolder")
    Dim myAttachments As Outlook.Attachments

    'location to save in. Can be root drive or mapped network drive.
    Const attPath As String = "T:\Daily Report Raw Data"
    Const attPath2 As String = "T:\Programmatic Deal Raw Data"

    'Change variables to match need. Comment or delete any part unnecessary.
    If (Msg.SenderEmailAddress = "[email protected]") And _
    (Msg.Subject = "Last 7 Day House Ads") And _
    (Msg.Attachments.Count >= 1) Then
    'save attachment
    Set myAttachments = Item.Attachments
    myAttachments.Item(1).SaveAsFile attPath & "\Daily House Ads.xls"
    'mark as read
    Msg.UnRead = False
    'move email
    Set destfldr = objNS.GetFolderFromID("DFPHouse")
    Item.Move destfldr
    End If


Log in to reply
 

Looks like your connection to Codingislove Forum was lost, please wait while we try to reconnect.