Option Explicit
'*** Constants
Const CLASSNAME = "Linked Notes Manager"
Const VERSION = "v1.0"
Const LINKEDNOTEFOLDER = "Linked Notes"
'The name of the folder that the linked notes will go in'
Const LINKPROPERTY = "LinkedNote"
'The name of the item property containing the link to the note'
Const FORCEONTOP = False
'True | False'
'If True, the notes will appear on top of the linked item'
'If False, the note appears behind the linked item'
Const msoControlButton = 1
Const msoButtonIconAndCaption = 3
'*** Class variables
Private WithEvents olkApp As Outlook.Application, _
WithEvents olkInspectors As Outlook.Inspectors, _
olkInspector As Outlook.Inspector, _
olkNotesFolder As Outlook.Folder
Private Sub Class_Initialize()
On Error Resume Next
Set olkNotesFolder = Session.GetDefaultFolder(olFolderNotes).Folders(LINKEDNOTEFOLDER)
If TypeName(olkNotesFolder) = "Nothing" Then
Set olkNotesFolder = Session.GetDefaultFolder(olFolderNotes)
Set olkNotesFolder = olkNotesFolder.Folders.Add(LINKEDNOTEFOLDER, olFolderNotes)
End If
Set olkApp = Application
Set olkInspectors = olkApp.Inspectors
On Error GoTo 0
End Sub
Private Sub Class_Terminate()
Set olkApp = Nothing
Set olkInspectors = Nothing
Set olkInspector = Nothing
Set olkNotesFolder = Nothing
End Sub
Private Sub olkApp_ItemContextMenuDisplay(ByVal CommandBar As Office.CommandBar, ByVal Selection As Selection)
Dim objButton As Object, _
olkItem As Object, _
bolLinked As Boolean
Set objButton = CommandBar.Controls.Add(msoControlButton)
If Selection.Count = 1 Then
Set olkItem = Selection.Item(1)
If olkItem.Class = olMail Then
bolLinked = IsLinked(olkItem)
With objButton
.Style = msoButtonIconAndCaption
.Caption = IIf(bolLinked, "Remove", "Add") & " Linked Note"
.Parameter = Selection.Item(1).EntryID
.FaceId = IIf(bolLinked, 348, 347)
.OnAction = IIf(bolLinked, "Project1.ThisOutlookSession.RemoveLinkedNote", "Project1.ThisOutlookSession.AddLinkedNote")
End With
End If
End If
End Sub
Private Sub olkInspectors_NewInspector(ByVal Inspector As Inspector)
Dim olkMsg As Outlook.MailItem, _
olkNote As Outlook.NoteItem, _
olkProp As Outlook.UserProperty
On Error Resume Next
If Inspector.CurrentItem.Class = olMail Then
Set olkMsg = Inspector.CurrentItem
Set olkProp = olkMsg.UserProperties.Find(LINKPROPERTY, True)
If TypeName(olkProp) = "UserProperty" Then
Set olkNote = Session.GetItemFromID(olkProp.Value)
If TypeName(olkNote) <> "Nothing" Then
olkNote.Display FORCEONTOP
Else
MsgBox "The note linked to this item could not be found.", vbInformation + vbOKOnly, CLASSNAME
End If
End If
End If
Set olkMsg = Nothing
Set olkNote = Nothing
Set olkProp = Nothing
On Error GoTo 0
End Sub
Private Function IsLinked(ByRef olkItem As MailItem) As Boolean
Dim olkProp As Outlook.UserProperty
Set olkProp = olkItem.UserProperties.Find(LINKPROPERTY)
If TypeName(olkProp) = "Nothing" Then
IsLinked = False
Else
If olkProp.Value = "" Then
IsLinked = False
Else
IsLinked = True
End If
End If
End Function
Public Sub AddNoteToMsg()
Dim olkMsg As Object, _
olkNote As Outlook.NoteItem, _
olkProp As Outlook.UserProperty
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set olkMsg = Application.ActiveExplorer.Selection(1)
Case "Inspector"
Set olkMsg = Application.ActiveInspector.CurrentItem
End Select
If olkMsg.Class = olMail Then
Set olkNote = olkNotesFolder.Items.Add()
olkNote.Body = "Linked to: " & olkMsg.Subject
olkNote.Save
Set olkProp = olkMsg.UserProperties.Add(LINKPROPERTY, olText)
olkProp.Value = olkNote.EntryID
olkMsg.Save
olkNote.Display
End If
Set olkProp = Nothing
Set olkNote = Nothing
Set olkMsg = Nothing
On Error GoTo 0
End Sub
Public Sub DeleteNoteFromMsg()
Dim olkMsg As Outlook.MailItem, _
intIndex As Integer
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set olkMsg = Application.ActiveExplorer.Selection(1)
Case "Inspector"
Set olkMsg = Application.ActiveInspector.CurrentItem
End Select
If olkMsg.Class = olMail Then
For intIndex = 1 To olkMsg.UserProperties.Count
If olkMsg.UserProperties.Item(intIndex).Name = LINKPROPERTY Then
olkMsg.UserProperties.Remove intIndex
olkMsg.Save
End If
Next
End If
On Error GoTo 0
Set olkMsg = Nothing
End Sub
i. Double-click on the ThisOutlookSession module at the top of the Project panel.
Private objLNM As LinkedNotesManager
Private Sub Application_Quit()
Set objLNM = Nothing
End Sub
Private Sub Application_Startup()
Set objLNM = New LinkedNotesManager
End Sub
Sub AddLinkedNote()
objLNM.AddNoteToMsg
End Sub
Sub RemoveLinkedNote()
objLNM.DeleteNoteFromMsg
End Sub
k. Click the diskette icon on the toolbar to save the changes
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (8)
Author
Commented:Commented:
Sorry if I thought you might have physic powers (!): I realised they had nothing to do with Linked Notes, but - as the window opened with the cursor between those two lines ready for typing - I had assumed it was two lines that Outlook always included by default when you first opened that object. Obviously not!
Commented:
There you said:
"Copy the code between the THISOUTLOOKSESSION tags and paste it into the right-hand pane of the editor window."
I thought maybe it was those 'tags' that I had erroneously deleted, and had thought you might know what they are - or does that not apply to this later version of the code?
Author
Commented:Would you mind opening a question on this issue so we can continue the troubleshooting there? I'm concerned about cluttering the article and comments with troubleshooting on one specific issue. If that's okay, then don't worry about the point value. I'm not looking to score points, just tying to keep the article comments from getting too confusing.
Commented:
Thanks, Trevor
View More