Outlook VBA help - Please

Daniellel

Board Regular
Joined
Jun 21, 2011
Messages
242
*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;

  1. Asks for a source folder for which all sub-folders are to be processed
  2. Asks for a destination folder into which the emails are to be “copied”
  3. 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 If

End Sub
 

Some videos you may like

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
367
Office Version
  1. 365
Platform
  1. Windows
Set mycopieditem = objFolder.myItems(i).Copy

This is the cause of the problem. myItems doesn't exist -> it should be items:

VBA Code:
Set mycopieditem = objFolder.Items(i).Copy

I tried it, and with the above change, it seems to work. Hope that helps.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,521
Messages
5,625,296
Members
416,087
Latest member
drth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top