I've been using my Outlook Tags system this week and it's been very nice. I've made some changes over the week and I thought both people who were interested in this might be interested in the changes as well.
I changed the Tags textbox into a combobox as, I believe, Ken Puls suggested. I don't have to type out the whole folder name because it autofills and it helps to prevent accidental misspellings. The downside is that I need a list of folders before I show the form, which is why I didn't implement it to begin with. In its original form, I only recursed through the folder tree when I clicked the Save button. If I canceled, those cycles weren't wasted. But it was worth a try, and as it turns out, it takes less than a second to load all the folder names into a collection and sort the collection.
Sub FillFolders(fldStart As MAPIFolder)
Dim fld As MAPIFolder
Set gcolFolders = New Collection
If fldStart Is Nothing Then
Set fldStart = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
End If
RecurseFolders fldStart
SortFolders gcolFolders
End Sub
Sub RecurseFolders(fldStart As MAPIFolder)
Dim fld As MAPIFolder
For Each fld In fldStart.Folders
On Error Resume Next
gcolFolders.Add fld, fld.FolderPath
On Error GoTo 0
If fld.Folders.Count> 0 Then
RecurseFolders fld
End If
Next fld
End Sub
Sub SortFolders(col As Collection)
Dim i As Long
Dim j As Long
Dim fTemp As MAPIFolder
For i = 1 To col.Count - 1
For j = i + 1 To col.Count
If col(i)> col(j) Then
'store the lesser item
Set fTemp = col(j)
'remove the lesser item
col.Remove j
're-add the lesser item before the
'greater Item
col.Add fTemp, fTemp.FolderPath, i
End If
Next j
Next i
End Sub
Another problem I encountered was that while my Inbox was being managed, my SentItems was as out of control as ever. I needed something to handle my replies and forwards as well as new mail. For replies and forwards, my first thought was to move the email first, then reply. For this, I needed to change the focus of Outlook to the folder to which I moved the email. I'm sure that's possible, but I couldn't find a good way to do that. Changing the CurrentFolder property didn't work or didn't work the way I wanted, I don't remember. I decided a better approach was to move related emails in the SentItems folder at the same time I move the Inbox item. To wit:
Private Sub MoveSentMail(sTopic As String, fldTag As MAPIFolder)
Dim mi As Object
Dim i As Long
Dim fldr As MAPIFolder
Set fldr = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
For i = fldr.Items.Count To fldr.Items.Count - 5 Step -1
Set mi = fldr.Items(i)
If mi.ConversationTopic = sTopic Then
mi.Move fldTag
End If
Next i
End Sub
Note that I only look through the last five sent emails. It turns out that looping through MailItems in a MAPIFolder is time consuming. Even limiting it to the last 20 items was a noticeable delay. Five works for me because nothing sits in my inbox for very long. It may not be a generally appealing feature though.
If I Tools > Find > Related Messages in the UI, and switch to the Advanced tab, I can see that Outlook uses the Conversation field to determine the match. There is a ConversationIndex and a ConversationTopic property in the object model. ConversationIndex sounds better, but I didn't have much luck using it. ConversationTopic, on the other hand, seems to work nicely finding the related message.
My workflow is something like this: I receive an email, read it, respond to it, then move it to a folder. Moving items from SentItems like I'm doing works well, but I'm not sure it will work well for people who go through their email differently. I can't include more items in SentItems because it simply takes too long.
For new email I send, I created a new sub that does pretty much the same thing as the old sub.
Public Sub TagSentMail()
Dim mi As MailItem
Dim ufTag As UTags
Dim sTag As String
Dim lFlagColor As Long
Dim fldTag As MAPIFolder
On Error Resume Next
Set mi = Application.ActiveInspector.CurrentItem
On Error GoTo 0
If Not mi Is Nothing Then
InitGlobals
Set ufTag = New UTags
ufTag.Subject = mi.Subject
ufTag.Show
'get info back from userform
If Not ufTag.UserCancel Then
If ufTag.Flag Then lFlagColor = ufTag.FlagColor
mi.FlagStatus = olFlagMarked
mi.FlagIcon = lFlagColor
'move item to folder
If ufTag.xFolder Is Nothing Then
sTag = ufTag.xTag
Set fldTag = gfldStart.Folders.Add(StrConv(sTag, vbProperCase))
Else
Set fldTag = ufTag.xFolder
End If
Set mi.SaveSentMessageFolder = fldTag
End If
End If
End Sub
Retrieving mi is different because I'm calling this from the Inspector window that contains the new email, rather than the Inspector window that contains a selected message in a folder. Also, I'm not moving this email, I'm setting its SaveSentMessageFolder property to save it to the correct folder.
If you compare this to my sub that moves a message, you'll notice some other differences too. I don't have to recurse through the folders any more because I do that before I show the form (in order to fill the combobox). Instead of getting a string tag back from the userform, I can get one of two things. I can get a MAPIFolder object which means the user selected something from the list or I can get a string tag which means the user typed a new value into the combobox. From the code behind the Save button:
If Me.cbxTag.MatchFound Then
Set mobjxFolder = gcolFolders(Me.cbxTag.ListIndex + 1)
Else
msXTag = Me.cbxTag.Text
End If
Then if the property that holds the MAPIFolder is Nothing, I create a folder using the string.
Download OutlookTags2.zip, which consists of a .bas file and a .frm file.
