| Code level: intermediate Code area: Basic Outlook Printer Friendly Version | ||
| Title: Delete old appointments en masse | ||
| Description: A little function I created to clean out large mailboxes. Useful when I had a problem archiving a large calendar folder! | ||
| Date: 18-Jun-2003 08:38 | ||
| Code level: intermediate | ||
| Code area: Basic Outlook | ||
| Posted by: chris cahill | ||
| Body: |
||
| All 3comments |
|
Page [ 1 ] | |
|
|
chris cahill
19-Jun-2003 10:18
forgot to add this function Function Quote(MyText) As String Quote = Chr(34) & MyText & Chr(34) End Function Courtesy of Sue. |
|
|
|
Jesper Bendtsen
26-Jul-2007 02:57
Why is it not working for me!? I have made a form in VBA (added ref. Microsoft Outlook 11.0 library), in Outlook2003. With a button to click on, but it says is empty ("no items found") and it is not, I have made a test appointment on the date. 08/10/2007 08:00 PM! Please help me, I want to delete all appointments in the range!? strStart = "08/12/2007 07:00 PM" strEnd = "08/06/2007 18:00 AM" The code is here: 'Declarations Dim strCurrent As String Dim objApp As Outlook.Application Dim objNS As Outlook.NameSpace Dim objFolder As Outlook.MAPIFolder Dim objItems As Outlook.Items Dim objItem As Object Dim strStart As String Dim strEnd As String Dim strFilter As String Private Sub CommandButton1_Click() DeleteAppts End Sub Private Function DeleteAppts() 'put required start and end dates into strStart and strEnd respectively 'if they are constants then just set them before this 'I created textboxes for users to input the dates themselves strStart = "08/12/2007 07:00 PM" strEnd = "08/06/2007 18:00 AM" 'create a string to use to filter the outlook items strFilter = "[Start] >= " & Quote(strStart) & " And [Start] < " & Quote(strEnd) 'set the outlook objects and specify the items in the calendar using the filter Set objApp = CreateObject("Outlook.Application") Set objNS = objApp.GetNamespace("MAPI") Set objFolder = objNS.GetDefaultFolder(olFolderCalendar) Set objItems = objFolder.Items.Restrict(strFilter) Set objItem = objItems.GetFirst Do 'If there returned no items, then exit out If objItem Is Nothing Then MsgBox "no items found" Exit Do End If For Each objItem In objItems 'deletes each item, then goes on to the next objItem.Delete Next Loop 'clears out outlook objects from memory Set objApp = Nothing Set objNS = Nothing Set objFolder = Nothing Set objItems = Nothing Set objItem = Nothing End Function Function Quote(MyText) As String Quote = Chr(34) & MyText & Chr(34) End Function |
|
|
|
Sue Mosher
29-Jul-2007 12:38
Jesper, I'm not sure why that search isn't working for you, but I'd suggest that you alter your search string to use the approach detailed at http://www.outlookcode.com/article.aspx?id=30 . More importantly, your Do loop will not be effective in deleting all the items. You can use a countdown loop instead: intCount = objItems.Count For i = intCount to 1 Step -1 Set objItem = objItems(i) objItem.Delete Next |
|
|
|
Page [ 1 ] | |
| Post your comment name email  |