Archive tasks upon completion

[Guest]

I've done alot of VBA programming in Access and Excel, even some in Word, but
this is my first venture into Outlook, so please bear with the newbie;
I'm wanting to create a macro that can run either manual (ie: linked to the
toolbar) or on exiting Outlook.

The macro needs to move any task that is 100% completed to the archive file.
In short to "auto-archive" the tasks when they are marked as completed or as
a manual operation performed using the macro list or a toolbar button.
It needs to search thru: either all the Task folders (there will be multiple
folders, one for each production facility) or the current task folder,
whichever is easier, and any task that has Status = 2 (completed) is moved to
the corresponding Archive folder.

I've been searching thru various websites, including slipstick and
outlookcode.com, and while very helpful, there's not a lot about the Tasks
folders & items.

I'm also pouring thru "Programming Microsoft Outlook 2000" to attempt to get
a grasp of the Outlook Object Model.

Any suggestions would be greatly appreciated.

Dan Knight
(e-mail address removed)

 

[Sue Mosher [MVP-Outlook]]

The scenario you describe requires nothing that's task-specific. It's a
straightforward matter of using the MAPIFolder.Items.Restrict method to
return an Items collection filtered for the criteria you want (Status = 2).
You then iterate that collection in a countdown loop and move each item to
the desired target folder. See
http://www.outlookcode.com/codedetail.aspx?id=321 for a related sample.

To get a non-default folder (ie. your target folder), you need to walk the
folder hierarchy using the Folders collections or use a function that does
that for you. See http://www.outlookcode.com/d/code/getfolder.htm

 

[Guest]

Sue;
Thank-you for your help. It was extremely helpful in pointing me in the
right direction.

Following for the list is the code I created to accomplish the goal.

Thanks again, Dan

Sub ArchiveCompletedTasks()
' Developed by Dan Knight of Knight Information Services,
(e-mail address removed)
' Code to move any completed tasks from their respective task folders
to a corresponding task foldder in an Archive file.
' It was developed using by modifing sample code from
http://www.outlookcode.com/codedetail.aspx?id=321
' It also uses the GetFolder Function acquired at
http://www.outlookcode.com/d/code/getfolder.htm
'
' Limitations:
' Only runs on selected task folder, but could be modified to
run on any type of folder and any type of item.
' It doesn't search thru sub-folders of the selected folder.
'

Dim objArchiveFolderRoot As Outlook.MAPIFolder
Dim strFindFolder As String

Dim appOL As New Outlook.Application
Dim objCurrentFolder As Outlook.MAPIFolder
Dim objArchiveFolder As Outlook.MAPIFolder
Dim objDestinationFolderRoot As Outlook.MAPIFolder
Dim strCurrentFolderPath As String, strCurrentFolderName As String
Dim strArchiveFolder As String, strArchiveFolderName As String,
strFindFolder As String
Dim arrFolders() As String
Dim intCurrentFolderType As Integer, intNewFolderType As Integer
Dim itmTask As TaskItem
Dim myItems As Outlook.Items
Dim i As Integer, intCount As Integer, intCounter As Integer

' Sets the current selected folder
Set objCurrentFolder = appOL.ActiveExplorer.CurrentFolder
strCurrentFolderPath = objCurrentFolder.FolderPath
intCurrentFolderType = objCurrentFolder.DefaultItemType
' Uses the SetFolderType function (see below) to determine the type
of Folder to create if needed.
intNewFolderType = SetFolderType(intCurrentFolderType)

' Change "Archive Folders" to what your archive file is named.
strArchiveFileName = "Archive Folders"
' Sets the objDestinationFolderRoot object to the name of the
Archive File
Set objArchiveFolderRoot = GetFolder(strArchiveFileName)
Set objArchiveFolder = GetFolder("Archive Folders\Tasks")
' If the specified folder doesn't exist then add a new Task folder
If objArchiveFolder Is Nothing Then
Set objDestinationFolder =
objArchiveFolderRoot.Folders.Add(strCurrentFolder, intNewFolderType)
End If

' Creates a zero-based, 1 dimensional array of all the folders in
Current Folder Path
arrFolders() = Split(Right(strCurrentFolderPath,
Len(strCurrentFolderPath) - InStr(3, strCurrentFolderPath, "\")), "\")
strFindFolder = strArchiveFileName
' Loops thru each subfolder of the Current Folder to ensure that it
exists in the Archive folder.
' If the subfolder name doesn't exist in the Archive folder a new
one is created.
For i = 0 To UBound(arrFolders())
strFindFolder = strFindFolder & "\" & arrFolders(i)
Test4Folder:
Set objArchiveFolder = GetFolder(strFindFolder)
If objArchiveFolder Is Nothing Then
objArchiveFolderRoot.Folders.Add (arrFolders(i))
GoTo Test4Folder
Else
Set objArchiveFolderRoot = objArchiveFolder
End If
Next i
' This creates a collection of Task items that have their status = 2
(Completed).
' NOTE: Change the "[Status] = 2" to reflect whatever field and
value you are wanting to test for.
Set itmMyItems = objCurrentFolder.Items.Restrict("[Status] = 2")
intCount = itmMyItems.Count
intCounter = 0
' Loops thru the collection and moves each one to the respective
Archive folder.
For i = intCount To 1 Step -1
Set itmTask = itmMyItems(i)
itmTask.Move objArchiveFolder
intCounter = intCounter + 1
Next
' Closing message to advise user of how many items were moved.
MsgBox intCounter & "Tasks were archived."
End Sub
Function SetFolderType(intCurrentFolderType As Integer) As Long
' This uses the Outlook Constants for ItemType and DefaultFolders
Select Case intCurrentFolderType
Case Is = 0 ' olMailItem
SetFolderType = 6
' Sets folder type to olFolderInbox, however
' it is crucial to note that there are different types of
"mail" folders;
' see Outlook Constants in the Help file for more info.
Case Is = 1 ' olAppointmentItem
SetFolderType = 9
' Sets folder type to olFolderCalendar
Case Is = 2 ' olContactItem
SetFolderType = 10
' Sets folder type to olFolderContacts
Case Is = 3 ' olTaskItem
SetFolderType = 13
' Sets folder type to olFolderTasks
Case Is = 4 ' olJournalItem
SetFolderType = 11
' Sets folder type to olFolderJournal
Case Is = 5 ' olNoteItem
SetFolderType = 12
' Sets folder type to olFolderNotes
Case Is = 6 ' olPostItem
SetFolderType = 18
' Sets folder type to olPublicFoldersAllPublicFolders
Case Is = 7 ' olDistributionListItem
SetFolderType = 10
' Sets folder type to olFolderContacts
End Select
End Function