Folder path in outlook for moving files

gmayor · #6 12-18-2017, 10:21 PM

To answer both your questions, 'Dim objMsg As MailItem' requires that all the items checked are actually mail items. If there are mixed item types in the folder use

Code:

Dim objMsg As Object

The code suggested was for a single message.

The code checks that the appropriate folder exists for each message and creates it only if missing; and as you wanted to avoid hard coding the path, it also locates the named folder in the folder tree in order to move the message to it. If however you want to process a folder full of messages into the same sub folder , then lose the function and process the messages in a loop in the main macro, testing for the folder with the first message only e.g. as follows.

Process the messages in reverse order so that the movement of the messages doesn't upset the count.

The process moves all the messages from the selected startfolder to the named sub folder of that startfolder.

Code:

Option Explicit

Sub MoveMessages()
Dim olNS As NameSpace
Dim cFolders As Collection
Dim strFolderName As String
Dim olFolder As Outlook.Folder
Dim StartFolder As Outlook.Folder
Dim SubFolder As Outlook.Folder
Dim olItem As Object
Dim bExists As Boolean
Dim iMsg As Integer

    Set cFolders = New Collection
    Set olNS = GetNamespace("MAPI")
    strFolderName = InputBox("Enter the name of the folder to move the messages to")    'The target folder
    Set StartFolder = olNS.PickFolder
    For iMsg = StartFolder.Items.Count To 1 Step -1
        Set olItem = StartFolder.Items(iMsg)
        If iMsg = StartFolder.Items.Count Then
            cFolders.Add StartFolder
            Do While cFolders.Count > 0
                Set olFolder = cFolders(1)
                cFolders.Remove 1
                If UCase(olFolder.Name) = UCase(strFolderName) Then
                    bExists = True
                    Exit Do
                End If
                For Each SubFolder In olFolder.folders
                    cFolders.Add SubFolder
                Next SubFolder
            Loop
            If Not bExists Then
                Set olFolder = StartFolder.folders.Add(strFolderName)
            End If
        End If
        olItem.Move olFolder
    Next iMsg
lbl_Exit:
    Set olNS = Nothing
    Set StartFolder = Nothing
    Set cFolders = Nothing
    Set olFolder = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Save to PDF with predetermined filename and specific folder path	cutemich	Word VBA	1	05-09-2017 06:27 PM
Moving body text from old files to new files (based on template)	vagabond	Word	7	05-02-2017 03:24 PM
Linking to a spreadsheet in the same folder without folder path	Jacky837	Excel	0	07-30-2016 05:07 AM
Using user form fields as folder path and file name	carlandtina02	Excel Programming	3	04-15-2016 01:47 PM
How to find the path to the downloads folder when it is different for each user	CatMan	Excel Programming	2	12-07-2012 09:59 PM