More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 23-Mar-2017 00:52

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

Code level: beginner    Code area: Basic Outlook Printer Friendly Version
Title: auto expunge IMAP folders
Description: purpose of the macro is to automatically expunge all messages marked for deletion on all of your defined IMAP folders. the macro will press the 'Yes' button in the confirmation dialog when due.
Date: 22-May-2004  13:18
Code level: beginner
Code area: Basic Outlook
Posted by: Francesco martire
This message is displayed as VB.NET
 Option Explicit

' MatroExpungeIMAP
' code by Matro
' rome, italy, 2004
' matro@email.it
'
' this code may be used in compiled form in any way you desire. this
' file may be redistributed unmodified by any means PROVIDING it is
' not sold for profit without the authors written consent, and
' providing that this notice and the authors name is included. If
' the source code in this file is used in any commercial application
' then acknowledgement must be made to the author of this file
' (in whatever form you wish).
'
' this file is provided "as is" with no expressed or implied warranty.
' the author accepts no liability for any damage caused through use.
'
' important: expect bugs.
'
' use and enjoy. :-)

Const MATROEXPUNGEIMAP_RELEASE = "004"
Const MATROEXPUNGEIMAP_CLICKYESMLS = 2000
Const TemporaryFolder = 2

Public Sub MatroExpungeIMAP()
    
    Dim appOutlook, nsMapi, barEdit, btnPurge, rootFolder, btnConnect
    Dim ClickYesPath As String
    
    Set appOutlook = CreateObject("Outlook.Application")
    Set nsMapi = appOutlook.GetNamespace("MAPI")
    
    ' the macro is all here: it selects the Expunge button...
    Set barEdit = ActiveExplorer.CommandBars("Edit")
    Set btnPurge = barEdit.FindControl(msoControlButton, 5583, , , True)
    Set barEdit = ActiveExplorer.CommandBars("File")
    Set btnConnect = barEdit.FindControl(msoControlButton, 9441, , , True)
    If btnPurge Is Nothing Or btnConnect Is Nothing Then
        MsgBox "Select a valid IMAP folder once at least, then run this macro again.", vbInformation, "MatroExpungeIMAP"
        Exit Sub
    End If
    
    If nsMapi.Offline Then
        MsgBox "Go Online, then run this macro again.", vbInformation, "MatroExpungeIMAP"
        Exit Sub
    End If
    
    ' ...and it selects the 'Yes' button in the confirm dialog...
    ClickYesPath = ExpungeCreateClickYesScript()
    
    ' ...on each IMAP folder, recursively...
    For Each rootFolder In nsMapi.Folders()
        Call ExpungeCurrentFolder(nsMapi.Folders(rootFolder.Name), btnPurge, btnConnect, ClickYesPath)
    Next

    ' ...then it sits back on its window...
    Set ActiveExplorer.currentFolder = nsMapi.GetDefaultFolder(olFolderInbox)

    ' ...and that's all madams and sirs. :-)

End Sub

Private Sub ExpungeCurrentFolder(parentFolders, btnPurge, btnConnect, ClickYesPath As String)

    Dim currentFolder

    For Each currentFolder In parentFolders.Folders
        Call ExpungeCurrentFolder(currentFolder, btnPurge, btnConnect, ClickYesPath)
        DoEvents
        If currentFolder.DefaultItemType = olMailItem And Not btnConnect.Enabled Then
            Set ActiveExplorer.currentFolder = currentFolder
            If btnPurge.Visible Then
                If Len(ClickYesPath) > 0 Then
                    Call Shell("wscript " & ClickYesPath, vbHide)
                End If
                btnPurge.Execute
            End If
        End If
    Next

End Sub

Private Function ExpungeCreateClickYesScript() As String

    Dim fs, f
    
    ' basically, the auto click yes feature works by creating a VBScript routine
    ' which will be called asynchronously on a separate process.
    
    On Error Resume Next
    Set fs = CreateObject("Scripting.FileSystemObject")
    ExpungeCreateClickYesScript = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder), "MatroExpungeClickYes.vbs")
    Set f = fs.CreateTextFile(ExpungeCreateClickYesScript, True)
    f.WriteLine ("' this is part of MatroExpungeIMAP rel" & MATROEXPUNGEIMAP_RELEASE)
    f.WriteLine ("' MatroExpungeIMAP is an opensource macro for MS Outlook.")
    f.WriteLine ("'")
    f.WriteLine ("set sh=WScript.CreateObject(""WScript.Shell"")" & vbCrLf & "WScript.Sleep(" & (MATROEXPUNGEIMAP_CLICKYESMLS / 2) & ")")
    f.WriteLine ("activated = False: dt = 100: tw = " & MATROEXPUNGEIMAP_CLICKYESMLS)
    f.WriteLine ("Do While (Not activated And tw > 0)" & vbCrLf & "activated = sh.AppActivate(""Microsoft Office Outlook"")" & vbCrLf & "WScript.Sleep (dt): tw = tw - dt" & vbCrLf & "Loop")
    f.WriteLine ("If tw >= dt Then" & vbCrLf & "WScript.Sleep(dt): sh.SendKeys(""{TAB 2}{ENTER}"")" & vbCrLf & "End If")
    f.Close
    
    Set fs = Nothing
    
    If Err <> 0 Then ExpungeCreateClickYesScript = ""

End Function
All 46comments
Page [ 1 2 3 4 5 Next >>  
  14-Oct-2004  08:22   
Hi,

I'm not a programmer so forgive me if I seem a little nieve.
In order to have access to my e-mail from both at work and at home, I recently switched my method of accessing the server from POP to IMAP. The one thing I don't like about using IMAP is that when I delete a message it is "Marked for Deletion" and when I delete it, it is gone forever. I am an "e-mail packrat" and like to save my deleted messages in a folder (who knows when you might need something from the trash?). Can a code be written that will move all items that are marked for deletion into a "Deleted Items" folder?

Any help would be greatly appreciated.
  14-Oct-2004  09:50   
No. If you don't want to permanently delete messages, simply don't use the Edit | Purge Deleted Messages command.
  14-Oct-2004  10:33   
Hi again,

The workaround I've been using is as follows:
I manually move the messages I wish to delete into my "Deleted Items" folder without "deleting" them. When I do that, Outlook marks those messages for deletion in the inbox (or whatever other folder they are in). My next question is if there is a way to automate the moving of a selected message or messages from one folder into another and then purging those messages in the source folder that are marked for deletion?

Steven
  15-Oct-2004  07:07   
You would use the Move method to move the items, then adapt the code in the sample above to purge just the single folder you're interested in purging.
  18-Feb-2005  18:21   
I am a true newbie to VB programming, although I've played around with Word macros this is my first attempt at Outlook macros. With Word you can create them on the fly and figure out some of the coding after, but this is much different.

This macro starts with Option Explicit, which I don't really understand. If I just cut and paste this into the VB macro window, it appends to the previous macro everything from the Option Explicit command to the Const command. Is it supposed to do this? Also, if this is the only code I have, with no other macros present, it freezes up before finishing. What do I need to do?

Thanks,

John
  19-Feb-2005  13:41   
Option Explicit simply means that you can't use variables that you haven't declared with a Dim statement. It's a great way to protect against your own typos in variable names.

It might be easiest if you pasted this code into a new module, created with the Insert | Module command.
  05-Jun-2005  01:05   
Thanks Francesco!

I modified your code for use in my Outlook 2003 Addin, written using VB .net.

I have a ExpungeClick.vbs file with the following code:

set sh=WScript.CreateObject("WScript.Shell")
activated = False: dt = 25: tw = 2000
Do While (Not activated And tw > 0)
    activated = sh.AppActivate("Microsoft Office Outlook")
    WScript.Sleep (dt): tw = tw - dt
Loop
If tw >= dt Then
    WScript.Sleep(dt): sh.SendKeys("{TAB 2}{ENTER}")
End If

And in my Addin, i used the following code to run the script:
 Sub purgeIMAP()
        Dim myEdit As CommandBar = m_olExplorer.CommandBars("Edit")
        Dim myPurge As CommandBarControl = myEdit.Controls("Purge Deleted Messages")
        If myPurge.Visible Then
            Shell("wscript """ & programPath & "\ExpungeClick.vbs""", vbHide)
            myPurge.Execute()
            'DebugWriter("IMAP Expunged")
        End If
    End Sub

where programPath is the path of the vbs file.

This works great for me, so thanks for your great example!
  24-Jun-2005  15:34   
This is exactly what I want to do, i.e., purge IMAP messages that have been flagged for deletion programatically. I want to call it from a rule, but I'm not VB savvied enough. Please dumb it down for me. How do I apply the above VBS and Addin?
  05-Jul-2005  16:28   
Here's a script to copy message(s) to a "Deleted Items" folder, then purge the current mailbox. You have to create a "Deleted Items" folder in your IMAP account. Seems to work for both POP "Personal Folders" too, if you use it accidentally, but not for Exchange(who cares). After making the macro you can create a toolbar button to activate it. I'm no vbs guru, so no guarantees.
-----------------------------------------------------------------------------------------
Sub DeleteMessages()

Set myOlApp = CreateObject("Outlook.Application")

Dim myNameSpace As NameSpace

Set myNameSpace = myOlApp.GetNamespace("MAPI")

Dim myExplorer As Explorer

Set myExplorer = myOlApp.ActiveExplorer

'Get the folder type, expected type is 0 i.e. mail folder. If other type of folder
'being used then abort macro as it should only be used with mail folders.
folderType = myExplorer.CurrentFolder.DefaultItemType

'Check that folder is mail folder
If TypeName(myExplorer) = "Nothing" Or folderType <> 0 Then
GoTo invalidMailbox
End If

'Locate root folder for this account
Set thisFolder = myExplorer.CurrentFolder
Do Until thisFolder.Parent = myNameSpace
    Set thisFolder = thisFolder.Parent
Loop
Set accountFolder = thisFolder

'Identify selected messages
Dim selectedItems As Selection
Set selectedItems = myExplorer.Selection
Dim currentMailItem As MailItem
Dim iterator As Long

'Run loop on selected messages
For iterator = 1 To selectedItems.Count
Set currentMailItem = selectedItems.Item(iterator)

'Move messages to Deleted Items folder
Set trashFolder = accountFolder.Folders("Deleted Items")
currentMailItem.Move (trashFolder)

Next

'Now, purge deleted messages
Dim myBar As CommandBar
Set myBar = Application.ActiveExplorer.CommandBars("Menu Bar")
Dim myButtonPopup As CommandBarPopup
Set myButtonPopup = myBar.Controls("Edit")
Dim myButton As CommandBarButton
Set myButton = myButtonPopup.Controls("Purge Deleted Messages")
myButton.Execute

Exit Sub

invalidMailbox:
MsgBox ("Macro configured only to work with mail folders! ")

Exit Sub

End Sub
 
  28-Jul-2005  08:20   
Gary, a "run a script" rule fires only when a new message is received, so I'm not sure how relevant it would be to this code sample. But see http://www.outlookcode.com/d/code/zaphtml.htm for an example.
Page [ 1 2 3 4 5 Next >>