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)
    objMailItem.Delete
  Next i
 
  Set objNS = Nothing
  Set objInbox = Nothing
  Set objMailItem = Nothing
 
End Sub
bellboy2kAsked:
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)

to

    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)
    Else
        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("\"))
        Else
            szDir = szPath
            szPath = ""
        End If
        If IsNothing(flr) Then
            Set ns = app.GetNamespace("MAPI")
            Set flr = ns.Folders(szDir)
        Else
            Set flr = flr.Folders(szDir)
        End If
    Wend
    Set OpenMAPIFolder = flr
    On Error GoTo 0
    Exit Function
errOMF:
    Set OpenMAPIFolder = Nothing
    On Error GoTo 0
End Function

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

Cheers!
0
 
hiteshgupta1Commented:
>>Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Insted of this u have to use GetFolderFromID function
0
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.