Outlook 2010 macro to copy item links to the Windows clipboard

I have used OneNote for a few years to handle all my notes regarding different projects and all information I gather during work. It works very well, and I have during this time looked at how to use Outlook in a more advanced way. Of course, I want to tie the two products together.

In the basic form, it is possible to create OneNote note taking pages from an email or appointment in OneNote. This is nice, since I can simply bring up the context menu and choose "OneNote" in order to create a place for all my notes from this specific meeting (and also write down things to bring up before the meeting occurs so that I am prepared). I have however often run into the issue that a lot of scheduled meetings will be accompanied by separate emails containing information that is relevant. In some way I'd like to group these separate items together, preferably in the OneNote page that I have created for the meeting.

I looked at how OneNote creates a page for an email, which is in the same way as for an appointment. It will bring with it a few pieces of information and also create a link back to the email item in Outlook. This link is what I am interested in.

I looked into different ways of creating it. Most promising was a utility called Linker that can copy the internal ID of an Outlook item and put it in the clipboard. The flaw was that it prefixes the ID with "outlook:". This works natively for Outlook 2003. Outlook 2007 can handle it with a registry hack. Outlook 2010 will not handle it at all.

I at least got a bit closer to a solution.

I then found out that a proper prefix in Outlook 2010 is "onenote:outlook?folder=Contacts&entryid=". I looked into how to get the ID from the Outlook item via VBA code and it proved quite easy. I then hacked together a small Macro that would grab the ID from the currently selected item, create the correct HTML link with the prefix above, and then put it in the clipboard. This did of course not work.

The clipboard is an intricate piece of Windows that can handle a lot of different data. Putting raw text into it is simple, putting an HTML link into it a bit more difficult. I turned to Google and found a support article titled "How to add HTML code to the clipboard by using Visual Basic".

This helped me create the more intricate string used to identify HTML in Windows. Using this, I had it working.

After a while I noticed that special characters (å ä ö specifically since I'm in Sweden) did not work and got encoded in a wrong way. After trying different ways of encoding the string I finally resorted to try and put the entity name ä in the string and this worked! It is HTML I'm working with after all. A quick google gave me this nice piece of code to encode special characters in a string, and now I have it all working flawlessly.

My workflow now is as follows:
An appointment is made in Outlook, by me or someone else. I rightclick this and add a OneNote page with information regarding this meeting under a tab for the specific project. Those emails that are of interest for this meeting is then linked in the OneNote page using my Macro. I simply click the email in Outlook, hit my shortcut button to copy the link, and then paste it in OneNote. I have created the macro so that the link description is fetched from the subject in the email. Perfect!

I also noticed that the macro will create links to pretty much anything in Outlook. Emails, appointments, contacts and so on. This way I can link together all items in one OneNote page so I don't have to browse or search in Outlook for whatever I need.

Here is the complete code for the macro if you are interested:
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) _
   As Long
Private Declare Function GlobalAlloc Lib "kernel32" ( _
   ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function SetClipboardData Lib "user32" ( _
   ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias _
   "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
   As Long
Private Declare Function GlobalUnlock Lib "kernel32" ( _
   ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
   pDest As Any, pSource As Any, ByVal cbLength As Long)
Private Declare Function GetClipboardData Lib "user32" ( _
   ByVal wFormat As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" ( _
   ByVal lpData As Long) As Long
Private Const m_sDescription = _
                  "Version:1.0" & vbCrLf & _
                  "StartHTML:aaaaaaaaaa" & vbCrLf & _
                  "EndHTML:bbbbbbbbbb" & vbCrLf & _
                  "StartFragment:cccccccccc" & vbCrLf & _
                  "EndFragment:dddddddddd" & vbCrLf
                 
Private m_cfHTMLClipFormat As Long


Function RegisterCF() As Long
   'Register the HTML clipboard format
   If (m_cfHTMLClipFormat = 0) Then
      m_cfHTMLClipFormat = RegisterClipboardFormat("HTML Format")
   End If
   RegisterCF = m_cfHTMLClipFormat
End Function


Public Sub PutHTMLClipboard(sHtmlFragment As String, _
   Optional sContextStart As String = "", _
   Optional sContextEnd As String = "")
  
   Dim sData As String
  
   If RegisterCF = 0 Then Exit Sub
  
   'Add the starting and ending tags for the HTML fragment
   sContextStart = sContextStart & ""
   sContextEnd = "" & sContextEnd
  
   'Build the HTML given the description, the fragment and the context.
   'And, replace the offset place holders in the description with values
   'for the offsets of StartHMTL, EndHTML, StartFragment and EndFragment.
   sData = m_sDescription & sContextStart & sHtmlFragment & sContextEnd
   sData = Replace(sData, "aaaaaaaaaa", _
                   Format(Len(m_sDescription), "0000000000"))
   sData = Replace(sData, "bbbbbbbbbb", Format(Len(sData), "0000000000"))
   sData = Replace(sData, "cccccccccc", Format(Len(m_sDescription & _
                   sContextStart), "0000000000"))
   sData = Replace(sData, "dddddddddd", Format(Len(m_sDescription & _
                   sContextStart & sHtmlFragment), "0000000000"))
   'Add the HTML code to the clipboard
   If CBool(OpenClipboard(0)) Then
  
      Dim hMemHandle As Long, lpData As Long
     
      hMemHandle = GlobalAlloc(0, Len(sData) + 10)
     
      If CBool(hMemHandle) Then
         lpData = GlobalLock(hMemHandle)
         If lpData <> 0 Then
           
            CopyMemory ByVal lpData, ByVal sData, Len(sData)
            GlobalUnlock hMemHandle
            EmptyClipboard
            SetClipboardData m_cfHTMLClipFormat, hMemHandle
         End If
      End If
  
      Call CloseClipboard
   End If
End Sub


' Add the current selected item as Clipboard link
Sub AddOutlookItemAsClipboardLink()
    Dim linkString As String
    linkString = "{1}"
    linkString = Replace(linkString, "{0}", ActiveExplorer.Selection.Item(1).EntryID)
    linkString = Replace(linkString, "{1}", EncodeString(ActiveExplorer.Selection.Item(1).Subject()))
       
    PutHTMLClipboard (linkString)
End Sub


' Encodes special characters to their entity equivalent
Function EncodeString(ByVal strOriginal) As String
    Dim currChar, i, sOut, CharList
    CharList = "óáéíúÁÉÍÓÚ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿×÷ÀÂÃÄÅÆÇÈÊËÌÎÏÐÑÒÔÕÖØÙÛÜÝÞßàâãäåæçèêëìîïðñòôõöøùûüýþÿ"
    sOut = strOriginal
    For i = 1 To Len(CharList)
        currChar = Mid(CharList, i, 1)
        sOut = Replace(sOut, currChar, "&#x" & Hex(AscW(currChar)) & ";")
    Next
    EncodeString = sOut
End Function