CODEWITHSUNDEEP
vbaoutlookmailbox
troutusa
troutusa

Reputation: 1

Nested folder in Oulook root folders

I have VBA code that goes through all my email accounts and deletes the emails in the spam folder. The problem I am trying to resolve is that some of the accounts have the SPAM folder nested inside one of the account folders.

How can I get Outlook to check the nested folders for these accounts?

The following code successfully deletes the SPAM emails from multiple accounts but does not handle SPAM in subfolders.

Sub EmptySpamFolders() 

    Dim objNS As Outlook.NameSpace 
    Dim objAccount As Outlook.Account 
    Dim objFolder As Outlook.Folder 
    Dim objItem As Object

    On Error Resume Next ' Ignore errors and continue 

    Set objNS = Application.GetNamespace("MAPI") 

    ' Loop through all accounts 
    For Each objAccount In objNS.Accounts 

        Debug.Print objAccount.DeliveryStore.DisplayName 
        Debug.Print objAccount.AccountType 

        ' Check if the account has a spam folder 
        On Error Resume Next 
        Set objFolder = objAccount.DeliveryStore.GetRootFolder.Folders("Spam") 
        On Error GoTo 0 

        If Not objFolder Is Nothing Then 

            ' Check if the folder is empty 
            If objFolder.Items.Count > 0 Then 

                Debug.Print objFolder.Name 

                ' Delete all items in the spam folder 
                Do While objFolder.Items.Count > 0 
                    Set objItem = objFolder.Items(1) 
                    objItem.Delete 
                Loop 

            Else 

                Debug.Print "Spam folder is already empty for account: " & objAccount.DisplayName 

            End If 

        End If 

    Next objAccount 

    On Error GoTo 0 ' Reset error handling 

    MsgBox "Spam Folders have been cleared!", vbInformation, "Clear all SPAM folders" 

End Sub

I tried looking at the object model but I do not see any subfolders for the DeliveryStore folder object.

Mailbox Folder Structure sample. (Not all folders are shown)

[email protected]
-Inbox
-Gmail
--Drafts
--Spam (Emails Not Deleted)
-Drafts
-Outbox

[email protected]
-Inbox
--Fanduel
-Drafts
-Outbox
-Spam (Emails Deleted)

[email protected]
-Inbox
--Drafts
--spam (Emails Not Deleted)
-Outbox
-Search Folders

[email protected]
-Inbox
-[Gmail]
--Drafts
--Sent Mail
--Spam (Emails Not Deleted)
-Drafts
-Junk Email
-Outbox

Upvotes: 0

Views: 83

Answers (2)

troutusa
troutusa

Reputation: 1

I found a code snippet that I was able to modify to accomplish my task. The original code is left intact but the unnecessary portions have been remarked out to avoid running.

Option Explicit

Sub ListAllFoldersAndSubfolders()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.NameSpace
    Dim olAccount As Outlook.Account
    Dim olFolder As Outlook.Folder
    Dim olSubFolder As Outlook.Folder
'    Dim objItem As Object
'    Dim fso As Object
     Dim ts As Object
'    Dim sFilePath As String
    
    ' Initialize Outlook application object
    Set olApp = Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    ' Create a FileSystemObject to write to a text file
'    Set fso = CreateObject("Scripting.FileSystemObject")
'    sFilePath = "C:\Temp\OutlookFoldersList.txt" ' Specify the path to save the output file
'    Set ts = fso.CreateTextFile(sFilePath, True)
    
    ' Loop through each account in the Outlook namespace
    For Each olAccount In olNamespace.Accounts
'        ts.WriteLine "Account: " & olAccount.DisplayName
'        ts.WriteLine String(50, "-")
        
        ' Loop through each folder in the account
        For Each olFolder In olNamespace.Folders
            If olFolder.Store = olAccount.DeliveryStore Then
                Call sProcessFolder(olFolder, ts, 0)
            End If
        Next olFolder
    Next olAccount
    
'    ts.Close
'   MsgBox "Folders and subfolders have been listed in " & sFilePath
End Sub

Sub sProcessFolder(olFolder As Outlook.Folder, ts As Object, indent As Integer)
    Dim olSubFolder As Outlook.Folder
    Dim i As Integer
    Dim objItem As Object
    
    ' Write folder name with indentation
'    For i = 1 To indent
'        ts.Write "  "
'    Next i
'    ts.WriteLine olFolder.Name
    If olFolder.Name = "Spam" Or olFolder = "spam" Then
        If Not olFolder Is Nothing Then

            ' Check if the folder is empty
            If olFolder.Items.Count > 0 Then

                Debug.Print olFolder.Name

                ' Delete all items in the spam folder
                Do While olFolder.Items.Count > 0
                    Set objItem = olFolder.Items(1)
                    objItem.Delete
                Loop

            Else

'                Debug.Print "Spam folder is already empty for account: " & olFolder.FolderPath

            End If

        End If
    End If
    ' Loop through each subfolder
    For Each olSubFolder In olFolder.Folders
        Call sProcessFolder(olSubFolder, ts, indent + 1)
    Next olSubFolder
End Sub

The code checks every level of each account for a folder named "Spam" or "spam", and deletes the items in the folder. One click on a command added to my ribbon clears out all spam folders. (I could add junk and trash folders and automate clearing out all unwanted mail with one click.) :)

Upvotes: 0

niton
niton

Reputation: 9179

DeliveryStore appears to be non-standard for this purpose but you can get folders with:

Set objFolder = Session.Folders(objAccount.DeliveryStore.DisplayName)

When the Spam folder is not in the first level, this code loops through all the first level folders.

(If the Spam folder could be buried deeper a more elegant solution possibly using recursion would be needed.)

Option Explicit


Sub EmptyFirstLevelSecondLevelSpamFolders()

Dim objAccount As Account
Dim objFolder As folder
Dim objSpamFolder As folder
Dim objItem As Object

' Loop through all accounts
For Each objAccount In Session.Accounts

    Debug.Print
    Debug.Print "DeliveryStore.DisplayName: " & objAccount.DeliveryStore.DisplayName
    Debug.Print "AccountType..............: " & objAccount.AccountType
    
    ' Check if the account has a spam folder
    On Error Resume Next
    Set objSpamFolder = objAccount.DeliveryStore.GetRootFolder.Folders("Spam")
    ' Minimum error bypass
    On Error GoTo 0
        
    If Not objSpamFolder Is Nothing Then
    
        Debug.Print " Spam folder name.....: " & objFolder.Name
        Debug.Print "  Same level as Inbox."
        
        If objSpamFolder.Items.count > 0 Then
            
            Debug.Print " objSpamFolder.Items.count: " & objSpamFolder.Items.count
                    
            ' Delete all items in the Spam folder
            Do While objSpamFolder.Items.count > 0
                Set objItem = objSpamFolder.Items(1)
                objItem.Delete
            Loop
                    
        Else
        
            Debug.Print "  Spam folder is already empty for account: " & objAccount.DisplayName
        
        End If
        
    Else
    
        Set objFolder = Session.Folders(objAccount.DeliveryStore.DisplayName)
        
        Dim objFolderFoldersCount As Long
        objFolderFoldersCount = objFolder.Folders.count
        Debug.Print " First level folders.....: " & objFolderFoldersCount
        
        Dim i As Long
        Dim objfolderFirstLevel As folder
        Dim objSubSpamFolder  As folder
        
        For i = 1 To objFolderFoldersCount
        
            Set objfolderFirstLevel = objFolder.Folders(i)
            Debug.Print "  " & i & ": " & objfolderFirstLevel.folderPath
            
            On Error Resume Next
            Set objSubSpamFolder = objfolderFirstLevel.Folders("Spam")
            ' Minimum error bypass
            On Error GoTo 0
            
            If Not objSubSpamFolder Is Nothing Then
            
                Debug.Print "     In folder: " & objSubSpamFolder.folderPath
                
                ' Check if the folder is empty
                If objSubSpamFolder.Items.count > 0 Then
            
                    Debug.Print " objSubSpamFolder.Items.count: " & objSubSpamFolder.Items.count
                    
                    ' Delete all items in the Spam folder
                    Do While objSubSpamFolder.Items.count > 0
                        Set objItem = objSubSpamFolder.Items(1)
                        objItem.Delete
                    Loop
                    
                Else
        
                    Debug.Print "     Spam folder is already empty in: " & objfolderFirstLevel.folderPath
        
                End If
                
                ' When On Error Resume Next is used
                '  a found folder will persist in subsequent not found error situations
                Set objSubSpamFolder = Nothing
                
                ' Assumes one Spam folder per account
                Exit For
                
            End If
            
            ' When On Error Resume Next is used
            '  a found folder will persist in subsequent not found error situations
            Set objSubSpamFolder = Nothing
        
        Next
        
    End If
        
    ' When On Error Resume Next is used
    '  a found folder will persist in subsequent not found error situations
    Set objSpamFolder = Nothing

Next objAccount

MsgBox "Spam folders have been cleared!", vbInformation, "Clear all Spam folders"

End Sub

fyi. Avoid indiscriminate use of

On Error Resume Next ' Ignore errors and continue

Limit the scope to the least number of lines possible.

Upvotes: 0

Related Questions