Delete all messages in a subfolder

Posted on 2006-05-24
Medium Priority
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

Expert Comment

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

Accepted Solution

David Lee earned 750 total points
ID: 16759261
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

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article lists the top 5 trialware OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their Exchange server is no longer available or other critical issues with Exchange server or impo…
Are you looking for the options available for exporting EDB files to PST? You may be confused as they are different in different Exchange versions. Here, I will discuss some options available.
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…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…
Suggested Courses

807 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