Sub EmptyDeletedItems()
    'Empties the default Mailbox Deleted Items Folder along with
    'the Deleted Items folder in multiple Personal Folders / PSTs
    
    On Error GoTo ErrorHandler
    
    Dim objOutlookApp As Outlook.Application
    Dim mNameSpace As NameSpace
    Dim objExpl As Outlook.Explorer
    Dim objCBB As CommandBarButton
    Dim strEntryID As String
    Dim strStoreID As String
    
    Set objOutlookApp = CreateObject("Outlook.Application")
    Set mNameSpace = objOutlookApp.GetNamespace("MAPI")
    'Set the explorer to the active explorer
    Set objExpl = objOutlookApp.ActiveExplorer
    'Capture the original current folder Entry and Store ID's
    strEntryID = objExpl.CurrentFolder.EntryID
    strStoreID = objExpl.CurrentFolder.StoreID
    
    '***Empty Main Deleted Items Folder
    'Change the current folder to the target folder
    Set objExpl.CurrentFolder = mNameSpace.GetDefaultFolder(olFolderDeletedItems)
    'Select the target folder
    objExpl.SelectFolder mNameSpace.GetDefaultFolder(olFolderDeletedItems)
    'Get the Empty Deleted Items command = UID 1671
    Set objCBB = objExpl.CommandBars.FindControl(, 1671)
    'Execute the command
    objCBB.Execute
    
    '***Empty Personal Folders Deleted Items Folder
    'Change the current folder to the target personal folder / pst name
    Set personalFolder = mNameSpace.Folders("Friends")    'Friends is the name of the Personal Folder
    Set objExpl.CurrentFolder = personalFolder.Folders("Deleted Items")
    'Select the target folder
    objExpl.SelectFolder personalFolder.Folders("Deleted Items")
    'Get the Empty Deleted Items command = UID 1671
    Set objCBB = objExpl.CommandBars.FindControl(, 1671)
    'Execute the command
    objCBB.Execute
    
    '***Empty Personal Folders Deleted Items Folder
    'Change the current folder to the target personal folder / pst name
    Set personalFolder = mNameSpace.Folders("Family")     'Family is the name of the Personal Folder
    Set objExpl.CurrentFolder = personalFolder.Folders("Deleted Items")
    'Select the target folder
    objExpl.SelectFolder personalFolder.Folders("Deleted Items")
    'Get the Empty Deleted Items command = UID 1671
    Set objCBB = objExpl.CommandBars.FindControl(, 1671)
    'Execute the command
    objCBB.Execute
        
    'Return to the original folder
    Set objExpl.CurrentFolder = mNameSpace.GetFolderFromID(strEntryID, strStoreID)
    
ExitHere:
    On Error Resume Next
    Set objCBB = Nothing
    Set objExpl = Nothing
    Set mNameSpace = Nothing
    Set objOutlookApp = Nothing
    Set personalFolder = Nothing
    Exit Sub
ErrorHandler:
    Resume ExitHere
End Sub