Results 1 to 1 of 1

Thread: Moving of mails from specific sender to specific folder via excel

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Newbie
    Sep 2022

    Moving of mails from specific sender to specific folder via excel

    Hello all, I have this code, refers to subject of the email from excel A column to move it to respective outlook Subfolder named in B column, but instead of subject to use sender name , i tried to modified it but i failed. .. i need your help experts !!!

    Option Explicit
    Public Sub MoveEmailsToFolders()
        'arr will be a 2D array sitting in an Excel file, 1st col=subject, 2nd col=folder name
        '   // Declare your Variables
        Dim i As Long
        Dim rowCount As Integer
        Dim strSubjec As String
        Dim strFolder As String
    Dim olApp As Outlook.Application
        Dim olNs As Outlook.Namespace
        Dim myFolder As Outlook.Folder
        Dim Item As Object
    Dim Inbox As Outlook.MAPIFolder
        Dim SubFolder As Outlook.MAPIFolder
    Dim lngCount As Long
        Dim Items As Outlook.Items
        Dim arr() As Variant 'store Excel table as an array for faster iterations
        Dim WS As Worksheet
    'On Error GoTo MsgErr
    'Set Excel references
        Set WS = ActiveSheet
        If WS.ListObjects.Count = 0 Then
            MsgBox "Activesheet did not have the Excel table containing Subjects and Outlook Folder Names", vbCritical, "Error"
            Exit Sub
    arr = WS.ListObjects(1).DataBodyRange
            rowCount = UBound(arr, 2)
            If rowCount = 0 Then
                MsgBox "Excel table does not have rows.", vbCritical, "Error"
                Exit Sub
            End If
        End If
    'Set Outlook Inbox Reference
        Set olApp = New Outlook.Application
        Set olNs = olApp.GetNamespace("MAPI")
        Set myFolder = olNs.GetDefaultFolder(olFolderInbox)
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
        Set Items = Inbox.Items
    '   // Loop through the Items in the folder backwards
          For lngCount = Items.Count To 1 Step -1
            strFolder = ""
            Set Item = Items.Item(lngCount)
    'Debug.Print Item.Subject
    If Item.Class = olMail Then
                'Determine whether subject is among the subjects in the Excel table
                For i = 1 To rowCount
                    If arr(i, 1) = Item.Subject Then
                        strFolder = arr(i, 2)
    '// Set SubFolder of Inbox, read the appropriate folder name from table in Excel
                        Set SubFolder = Inbox.Folders(strFolder)
                        '// Mark As Read
                        Item.UnRead = False
                        '// Move Mail Item to sub Folder
                        Item.Move SubFolder
                        Exit For
                        End If
                    Next i
                End If
    Next lngCount
        Set Inbox = Nothing
          Set SubFolder = Nothing
        Set olNs = Nothing
        Set Item = Nothing
    Exit Sub
    '// Error information
        MsgBox "An unexpected Error has occurred." _
            & vbCrLf & "Error Number: " & Err.Number _
            & vbCrLf & "Error Description: " & Err.Description _
            , vbCritical, "Error!"
      Resume MsgErr_Exit
    End Sub
    Attached Images Attached Images
    Last edited by Aussiebear; 09-08-2022 at 01:16 PM. Reason: Added code tag to supplied code

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