*Any* help is appreciated and I fully understand this (Outlook rather than Excel) might all be new to you so will help as much as I can (I’ll be working on it also but a second set of eyes might see something my eyes have missed of haven’t yet been able to Google)
Requirement:
When a mailbox export is requested from the Messaging Team, they provide a PST folder with the relevant emails, however, the emails are in a folder structure Year\Month\Day\Hour which makes up/down arrows scrolling through the emails difficult.
The business has requested al emails be in a single folder so they can more easily review the email.
When executed, the macro;
Issues:
The macro “moves” rather than “copies”
The “copy” seems not to work hence the interim solution of “move”
There might be an issue with O365 based folders rather than PST based folders
Desired outcomes:
Work out why “copy” isn’t working
Make sure the code works against O365 folders as well as PST folders (it is working for PST based folders)
Below is the code;
End Sub
Requirement:
When a mailbox export is requested from the Messaging Team, they provide a PST folder with the relevant emails, however, the emails are in a folder structure Year\Month\Day\Hour which makes up/down arrows scrolling through the emails difficult.
The business has requested al emails be in a single folder so they can more easily review the email.
When executed, the macro;
- Asks for a source folder for which all sub-folders are to be processed
- Asks for a destination folder into which the emails are to be “copied”
- Walks through the folder tree “moving” each item found into the target folder
Issues:
The macro “moves” rather than “copies”
The “copy” seems not to work hence the interim solution of “move”
There might be an issue with O365 based folders rather than PST based folders
Desired outcomes:
Work out why “copy” isn’t working
Make sure the code works against O365 folders as well as PST folders (it is working for PST based folders)
Below is the code;
VBA Code:
Dim objTargetFolder As Outlook.Folder
Sub BatchMoveEmailsFromSubfoldersToAnotherFolder()
Dim objSourceFolder As Outlook.Folder
Dim objFolder As Outlook.Folder
'Get the source folder whose subfolders to be processed
Set objSourceFolder = Application.Session.PickFolder
If Not (objSourceFolder Is Nothing) And objSourceFolder.DefaultItemType = olMailItem Then
If objSourceFolder.Folders.Count > 0 Then
'Select a target folder
Set objTargetFolder = Application.Session.PickFolder
If Not (objTargetFolder Is Nothing) Then
Call ProcessFolders(objSourceFolder)
For Each objFolder In objSourceFolder.Folders
Call ProcessFolders(objFolder)
Next
MsgBox "Move Completed!", vbExclamation
End If
Else
MsgBox "No subfolders!", vbExclamation
End If
End If
End Sub
Sub ProcessFolders(ByVal objFolder As Outlook.Folder)
Dim i As Long
Dim objSubfolder As Outlook.Folder
Debug.Print "Processing " & objFolder.Name & "." & objFolder.Items.Count & " item(s)."
For i = objFolder.Items.Count To 1 Step -1
'Move emails to the target folder
' If objFolder.Items(i).Class = olMail Then
Debug.Print objFolder.Items(i).Subject
'objFolder.Items(i).Move objTargetFolderobjtargetfolder
Set mycopieditem = objFolder.myItems(i).Copy
DoEvents
mycopieditem.Move objTargetFolder
DoEvents
Set mycopieditem = Nothing
DoEvents
' End If
Next
'Process subfolders recursively
If objFolder.Folders.Count > 0 Then
For Each objSubfolder In objFolder.Folders
Call ProcessFolders(objSubfolder)
Next
End IfEnd Sub
