Delete all messages in a subfolder

Posted on 2006-05-24
Last Modified: 2010-04-08
I got this Outlook VBA code from bruinte it works great but deletes all messages in the inbox. How can I change it from inbox to a sub folder of the inbox, say Inbox\Test?

Sub CleanupFolder()
Dim objNS As NameSpace
Dim objInbox As MAPIFolder
Dim objMailItem As Object
  Set objNS = Application.GetNamespace("MAPI")
  Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
  intItems = objInbox.Items.Count

  'Delete the Item
  For i = intItems To 1 Step -1
    Set objMailItem = objInbox.Items(i)
  Next i
  Set objNS = Nothing
  Set objInbox = Nothing
  Set objMailItem = Nothing
End Sub
Question by:bellboy2k
    LVL 8

    Expert Comment

    >>Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
    Insted of this u have to use GetFolderFromID function
    LVL 76

    Accepted Solution

    Greetings, bellboy2k.

    Add the code below to what you already have.  Then change this line

        Set objInbox = objNS.GetDefaultFolder(olFolderInbox)


        Set objInbox = OpenMAPIFolder("\Mailbox - Doe, Joe\Inbox\SubfolderName")

    'Credit where credit is due.
    'The code below is not mine (well, a little of it is).  I found it somewhere on the
    'internet but do not remember where or who the author is.  The original author(s)
    'deserves all the credit for these functions.
    Function OpenMAPIFolder(ByVal szPath As String)
        Dim app, ns, flr As MAPIFolder, szDir, i
        On Error GoTo errOMF
        Set flr = Nothing
        Set app = CreateObject("Outlook.Application")
        If Left(szPath, Len("\")) = "\" Then
            szPath = Mid(szPath, Len("\") + 1)
            Set flr = app.ActiveExplorer.CurrentFolder
        End If
        While szPath <> ""
            i = InStr(szPath, "\")
            If i Then
                szDir = Left(szPath, i - 1)
                szPath = Mid(szPath, i + Len("\"))
                szDir = szPath
                szPath = ""
            End If
            If IsNothing(flr) Then
                Set ns = app.GetNamespace("MAPI")
                Set flr = ns.Folders(szDir)
                Set flr = flr.Folders(szDir)
            End If
        Set OpenMAPIFolder = flr
        On Error GoTo 0
        Exit Function
        Set OpenMAPIFolder = Nothing
        On Error GoTo 0
    End Function

    Function IsNothing(Obj)
      If TypeName(Obj) = "Nothing" Then
        IsNothing = True
        IsNothing = False
      End If
    End Function
    'Macro Ends Here


    Featured Post

    Maximize Your Threat Intelligence Reporting

    Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

    Join & Write a Comment

    If you have never had your Outlook crash or suddenly lose messages, appointments, etc. you are fortunate. No matter how carefully you monitor your system, those things WILL happen, and recovering your data from a backup is not always possible, wh…
    Find out how to use dynamic social media in email signatures with this top 10 DOs & DON’Ts.
    Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
    This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

    755 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    17 Experts available now in Live!

    Get 1:1 Help Now