Consulting

Results 1 to 3 of 3

Thread: Moving Emails from inbox to a subfolder

  1. #1

    Moving Emails from inbox to a subfolder

    hi all,

    first of all thanks for any help.

    i've written a small script to read the subject from incoming emails and try to match it to a subfolder. For some reason the email isnt actually moved to the correct folder.

    Option Explicit
    Private WithEvents inboxItems As Outlook.Items
    Private Sub Application_Startup()
      Dim outlookApp As Outlook.Application
      Dim objectNS As Outlook.NameSpace
      
      Set outlookApp = Outlook.Application
      Set objectNS = outlookApp.GetNamespace("MAPI")
      Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
    End Sub
    Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    Dim MessageInfo
    Dim Result
    If TypeName(Item) = "MailItem" Then
      Call MoveToFolder(Item)
     
    End If
    ExitNewItem:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Number & " - " & Err.Description
        Resume ExitNewItem
    End Sub

    Sub MoveToFolder(newmail As Outlook.MailItem)
    On Error Resume Next
    
    
    
    
    
    
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim i As Integer
    Set objNS = GetNamespace("MAPI")
    Dim SubFolder As Outlook.MAPIFolder
       
    Set objFolder = objNS.Folders("xxx@xxxx.com).Folders("Inbox").Folders("Opportunities").Folders("Customers")
    
    
    Dim subject As String
    subject = newmail.subject
            
           For Each Item In objFolder.Folders
           If Item = "Birmingham" Then
           MsgBox ""
           End If
             'see if folder name is included in subject
             i = InStr(subject, Item)
             If i > 0 Then
                Set SubFolder = Inbox.Folders(Item)
                newmail.Move SubFolder 'email doesnt move
                Exit Sub
            End If
           Next
     
    End Sub

  2. #2
    You appear to have made up your own syntax for objFolder. The following should be closer

    Sub MoveToFolder(newmail As Outlook.MailItem)
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    
        Set objNS = GetNamespace("MAPI")
        Set objFolder = objNS.GetDefaultFolder(olFolderInbox).folders("Opportunities").folders("Customers")
        For Each SubFolder In objFolder.folders
            If InStr(newmail.subject, SubFolder.Name) Then
                newmail.Move SubFolder
                Exit For
            End If
        Next
        Set objNS = Nothing
        Set objFolder = Nothing
        Set SubFolder = Nothing
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3

    thank you

    Quote Originally Posted by gmayor View Post
    You appear to have made up your own syntax for objFolder. The following should be closer

    Sub MoveToFolder(newmail As Outlook.MailItem)
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    
        Set objNS = GetNamespace("MAPI")
        Set objFolder = objNS.GetDefaultFolder(olFolderInbox).folders("Opportunities").folders("Customers")
        For Each SubFolder In objFolder.folders
            If InStr(newmail.subject, SubFolder.Name) Then
                newmail.Move SubFolder
                Exit For
            End If
        Next
        Set objNS = Nothing
        Set objFolder = Nothing
        Set SubFolder = Nothing
    End Sub

    thanks Graham thats got it.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •