Modify a VBA script -- 2

Hi,
I have a script (from the internet and copied below) to delete duplicates in a selected Outlook folder.
I need to modify the below VBA script for Outlook to:
1) Scan each sub-folder (as well as the selected folder).
2) Instead of delete an item (at the remove step), permanently delete it.
(Note: The Deleted Items folder may already contain some items so it's not as simple as just emptying the Deleted Items folder).
3) Export the full name of each Folder being processed (e.g. Imported\Inbox\Info) from step 1 and Debug.Print output (from the processing/delete step) to a file C:\outlook_duplicates_clean_up_yyyy-mm-dd-hh-mm.txt (replace yyyy-mm-dd-hh-mm with current date/time).

Work must be well tested!!! Goal is to complete within 2 days.





Sub RemoveDuplicateItems()
Dim objFolder As Folder
Dim objDictionary As Object
Dim i As Long
Dim objItem As Object
Dim strKey As String
Dim objItems As Items

Set objDictionary = CreateObject("scripting.dictionary")
'Select a source folder
Set objFolder = Outlook.Application.Session.PickFolder
Set objItems = objFolder.Items
objItems.Sort "[ReceivedTime]", False

If Not (objFolder Is Nothing) Then
For i = objItems.Count To 1 Step -1
If Int(i / 1000) = i / 1000 Then
Debug.Print "---"
End If
Set objItem = objItems.Item(i)

Select Case objFolder.DefaultItemType
'Check email subject, body and sent time
Case olMailItem
On Error Resume Next
strKey = ""
strKey = objItem.Subject & "," & objItem.SentOn & "," & objItem.Body
If srtKey = "" Then
strKey = objItem.Subject & "," & objItem.ReceivedTime & "," & objItem.Body
End If
On Error GoTo 0
'Check appointment subject, start time, duration, location and body
Case olAppointmentItem
strKey = objItem.Subject & "," & objItem.Start & "," & objItem.Duration & "," & objItem.Location & "," & objItem.Body
'Check contact full name and email address
Case olContactItem
strKey = objItem.FullName & "," & objItem.Email1Address & "," & objItem.Email2Address & "," & objItem.Email3Address
'Check task subject, start date, due date and body
Case olTaskItem
strKey = objItem.Subject & "," & objItem.StartDate & "," & objItem.DueDate & "," & objItem.Body
End Select

strKey = Replace(strKey, ", ", Chr(32))

'Remove the duplicate items
If objDictionary.Exists(strKey) = True Then
objItem.Delete
Debug.Print i & " - " & Left(strKey, 90) & " - DELETE"
Else
objDictionary.Add strKey, True
Debug.Print i & " - " & Left(strKey, 90)

End If
Next i
End If
End Sub