WizzardOfOz
New member
- Joined
- Sep 4, 2013
- Messages
- 184
- Reaction score
- 0
- Points
- 0
- Location
- Australia
- Excel Version(s)
- Office 365
Google searching says that the PickFolder function can't display a user defined message. I'm asking the user to select three folders. The inbox, the project archive and a duplicate (or bin) folder. As per the code below I ask using a message box to display the requested folder, then the PickFolder function. I don't want to do a user defined form and add a treeview control because the project folder is HUGE and I don't want it to add the whole structure.
Any simple ideas. I thought of Inputbox and getting the user to select the folder in the normal navigation pane but there is no Type variable in Outlook's InputBox function
The recursive function RDuplicateMails then moves each item from the Inbox to either the project folder or if it's there already to the duplicates folder.
Any simple ideas. I thought of Inputbox and getting the user to select the folder in the normal navigation pane but there is no Type variable in Outlook's InputBox function
The recursive function RDuplicateMails then moves each item from the Inbox to either the project folder or if it's there already to the duplicates folder.
Code:
'inspired by http://randomscribblepad.blogspot.com.au/2011/01/automating-tasks-in-outlook-using-vb.html
Public Sub DeleteDuplicateMails()
Dim oInFolder As Folder, oProjFolder As Folder, oDupfolder As Folder 'the folders
Dim oProjMailItems 'the sorted collections
'ask the user for the three folders
If vbNo = [COLOR=#ff0000]MsgBox("Please select the folder with NEW e-mails", vbInformation + vbYesNo, "Select Inbox") [/COLOR]Then Exit Sub 'allow the user to cancel
[COLOR=#0000ff]Set oInFolder = Outlook.GetNamespace("MAPI").PickFolder[/COLOR] 'where is the new information
If vbNo = MsgBox("Please select the destination PROJECT folder", _
vbInformation + vbYesNo, "Select Project Archive") Then Exit Sub 'allow the user to cancel
Set oProjFolder = Outlook.GetNamespace("MAPI").PickFolder 'where is the Project archive
If vbNo = MsgBox("Please select the backup DUPLICATE folder", _
vbInformation + vbYesNo, "Select Duplicate Archive") Then Exit Sub 'allow the user to cancel
Set oDupfolder = Outlook.GetNamespace("MAPI").PickFolder 'where do the duplications go to
If vbNo = MsgBox("Inbox: " & oInFolder.Name & vbCrLf & _
"Project : " & oProjFolder.Name & vbCrLf & _
"Duplicates : " & oDupfolder.Name, vbInformation + vbYesNo, "Final Confirmation") Then Exit Sub 'allow the user to cancel
'set the prj items
Set oProjMailItems = oProjFolder.Items
oProjMailItems.Sort "[ReceivedTime]", olAscending
Call RDuplicateMails(oInFolder, oProjFolder, oDupfolder, "", oProjMailItems) 'Call recursive
'clean up any references
Set oProjMailItems = Nothing
Set oInFolder = Nothing
Set oProjFolder = Nothing
Set oDupfolder = Nothing
Call MsgBox("done")
End Sub