Outlook Technologies

Outlook Forms

Languages

Samples

More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 02-Sep-2010 22:20

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
Body: 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 45comments

	Page [ 1 2 3 4 5 Next >> ]
	Steven 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.
	Sue Mosher 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.
	Steven 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
	Sue Mosher 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.
	John Hunt 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
	Sue Mosher 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.
	Yuhua Li 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!
	Gary 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?
	lafong 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
	Sue Mosher 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 >> ]

name email