Delete all messages in a subfolder

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
Who is Participating?
David LeeConnect With a Mentor Commented:
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

>>Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Insted of this u have to use GetFolderFromID function
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.