Outlook 2007 VBA - apply action only when in specific Outlook account

Question

I'm using the following VBA project to apply a default string to the beginning of the Subject field with all new emails. BUT - I only want this script to function when Outlook has been opened into a specific account (ie I have 2 Outlook user accounts/PST files - personal & business - and only want the Subject string added to emails when I'm working in the business account) Fingers crossed - thanks for your help. Kirk

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If MsgBox("Send with 'Myrtleford Festival" at start of subject?", vbYesNo, "Send as Festival mail") = vbYes Then
        If (Left(Trim(Item.Subject), 11)) <> "The " Then
    Item.Subject = "The Myrtleford Festival 2012/ " + Item.Subject
    End If
End If

End Sub

Answer 1

OK, cool. In fact I stumbled on a totally foolproof & elegant solution. In Outlook's Trust Centre>Macro Security, I selected the option for "warn for all macros". Now when I open Outlook to any of my profiles, I get a pop-up asking if I want to enable/disable macros. Since the VBA script is the only macro running, I can easily filter whether the default subject string is used. Which will work 100% of the time forever (since I can't see any reason why I'll ever be using another macro/VBA script)

Answer 2

This is the basis of an approach.

It is sometime since I have had multiple accounts but, when I did, the top level folders were very different. The code below outputs to the Immediate window the names of the top level folders. On my current system this would give:

Personal Folders
Archive Folders
Test Folders

If your two accounts have different top level folders, you could distinguish your accounts from that.

If you like this approach but the top level folders are the same, I have a routine that searches for a specific folder at any depth in the hierarchy. Even if the main folders are the same, I assume some of the sub-folders are different.

Sub AnswerA()

  Dim InxIFLCrnt As Integer
  Dim TopLvlFolderList As Folders

  Set TopLvlFolderList = _
          CreateObject("Outlook.Application").GetNamespace("MAPI").Folders

  For InxIFLCrnt = 1 To TopLvlFolderList.Count
    Debug.Print TopLvlFolderList(InxIFLCrnt).Name
  Next

End Sub