![]() |
#1
|
|||
|
|||
![]()
Hi all,
Outlook 2007 and Windows 10 Home. I have updated my profile, but still shows as 2003. I am trying to put together some code to move emails easily in VBA. I have cobbled together the code below and have managed to get the Outlook folder path eg Inbox\Folder1\Folder2 I want to move the emails in Folder2 to the pst file with the same structure. For now we will assume the structure is there? What I cannot find out how to do at present is set the destination folder path using the above syntax and not Code:
Set objDestFolder = objNamespace.Folders("Inbox").Folders(""Folder1").Folders("Folder2") This is mainly for a manager who has levels you would not believe. I've had it working (not as it is now) with just a folder in the Inbox, but now want to expand it to cover all folders and then eventually create a folder if not present. However one thing at a time. Anyone able to help please.? TIA Code:
Sub MoveOldEmails() ' Declare all variables. Dim objOutlook As Outlook.Application Dim objNamespace As Outlook.NameSpace Dim objSourceFolder As Outlook.MAPIFolder Dim objDestFolder As Outlook.MAPIFolder Dim objFolders As Outlook.Folders Dim objFolder As Outlook.Folder, objParentFolder As Outlook.Folder Dim objVariant As Variant Dim lngMovedMailItems As Long Dim intCount As Integer, intDays As Integer Dim intDateDiff As Integer Dim strDestFolder As String, strFolderName As String, strFolder As String, strpath As String ' Create an object for the Outlook application. Set objOutlook = Application ' Retrieve an object for the MAPI namespace. Set objNamespace = objOutlook.GetNamespace("MAPI") ' Retrieve a folder object for the source folder. 'Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox) strFolderName = Application.ActiveExplorer.CurrentFolder.Name Set objSourceFolder = Application.ActiveExplorer.CurrentFolder ' ' Get full path strpath = strFolderName Set objParentFolder = objSourceFolder.Parent Do Until strFolder = "Personal Folders" strpath = objParentFolder.Name & "\" & strpath Set objParentFolder = objParentFolder.Parent strFolder = objParentFolder.Name Loop ' Loop through the items in the folder. NOTE: This has to ' be done backwards; if you process forwards you have to ' re-run the macro an inverse exponential number of times. For intCount = objSourceFolder.Items.Count To 1 Step -1 ' Retrieve an object from the folder. Set objVariant = objSourceFolder.Items.Item(intCount) ' Allow the system to process. (Helps you to cancel the ' macro, or continue to use Outlook in the background.) DoEvents ' Filter objects for emails or meeting requests. If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then ' This is optional, but it helps me to see in the ' debug window where the macro is currently at. 'Debug.Print objVariant.SentOn & " - " & objVariant.Subject & " - " & DateDiff("d", objVariant.SentOn, Now) ' Calculate the difference in years between ' this year and the year of the mail object. 'intDateDiff = DateDiff("yyyy", objVariant.SentOn, Now) intDays = DateDiff("d", objVariant.SentOn, Now) ' Only process the object if it older than 60 days If intDays > 60 Then ' Calculate the name of the personal folder. strDestFolder = Year(objVariant.SentOn) ' Retrieve a folder object for the destination folder. 'Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("Inbox").Folders(strFolderName) Set objDestFolder = objNamespace.(strDestFolder & "\" & strpath) ' Move the object to the destination folder. objVariant.Move objDestFolder ' Just for curiousity, I like to see the number ' of items that were moved when the macro completes. lngMovedMailItems = lngMovedMailItems + 1 ' Destroy the destination folder object. Set objDestFolder = Nothing End If End If Next ' Display the number of items that were moved. MsgBox "Moved " & lngMovedMailItems & " messages(s)." End Sub Last edited by Welshgasman; 12-18-2017 at 04:44 AM. Reason: Added new office version |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
cutemich | Word VBA | 1 | 05-09-2017 06:27 PM |
![]() |
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 |
![]() |
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 |