Outlook email link

Olivier N · October 6, 2016

I upgraded my productivity workflow today by achieving a tool that I really wanted but didn't found.

I can now create a link into a EN note to an Outtook email.

In Outlook :

- Select the email

- Click a button (the link is into the clipboard)

In EN:

- Paste into the note

It could be better if the EN Outlook Plugin adds automaticaly this link...

If you are interrested by a explaination, let me know (Works on Windows 10 with Outlook 2016).

gazumped · October 6, 2016

Hi. Thanks for the input - I'm sure anyone who uses Outlook (I'm on W10 O2013) would be interested to know more...

Olivier N · October 7, 2016

Step 1: Create outlook: shell (file outlook.reg attached)

Ensure the path is right or modify it (left clic on file, modify)
Double click on the file

		Windows Registry Editor Version 5.00
	
		[HKEY_CLASSES_ROOT\outlook]
	
		@="URL:outlook"
	
		"URL Protocol"=""
	
		[HKEY_CLASSES_ROOT\outlook\DefaultIcon]
	
		[HKEY_CLASSES_ROOT\outlook\shell]
	
		[HKEY_CLASSES_ROOT\outlook\shell\open]
	
		[HKEY_CLASSES_ROOT\outlook\shell\open\command]
	
		@="\"C:\\Program Files\\Microsoft Office\\root\\Office16\\outlook.exe\" /select \"%1\""

Step 2: Create Outlook macro (file OutlookLink.bas attached)

In Outlook, press ALT+F11
Menu File > Import File...
Select OutlookLink.bas, click Open
Save & Close
Create a button into Quick Access toolbar or Ribbon by right clicking on, and select "Macro" in "Categorie", then add "Project1.CopyOutlookLink". You could modify Name and Icon with "Modify..." button.

c5e481af-b672-4b18-adff-bae4753739d1.png?resizeSmall&width=832

		Attribute VB_Name = "OutlookLink"
	
		Sub CopyOutlookLink()
	
		   Dim m_sDescription As String
	
		   Dim sContextStart As String
	
		   Dim sContextEnd As String
	
		   Dim sHtmlFragment As String
	
		   Dim b() As Byte
	
		   Dim objMail As Outlook.MailItem
	
		   Dim doClipboard As New MSForms.DataObject
	
		   Dim link As String
	
		   Dim text As String
	
		   If Application.ActiveExplorer.Selection.Count <> 1 Then
	
		       MsgBox ("Select one and ONLY one message.")
	
		       Exit Sub
	
		   End If
	
		   Set objMail = Application.ActiveExplorer.Selection.Item(1)
	
		   link = "outlook:" & CStr(objMail.EntryID)
	
		   text = "Outlook : " + objMail.Subject & " (" + objMail.SenderName + ")"
	
		    m_sDescription = _
	
		                  "Version:1.0" & vbCrLf & _
	
		                  "StartHTML:aaaaaaaaaa" & vbCrLf & _
	
		                  "EndHTML:bbbbbbbbbb" & vbCrLf & _
	
		                  "StartFragment:cccccccccc" & vbCrLf & _
	
		                  "EndFragment:dddddddddd" & vbCrLf
	
		   sContextStart = "<HTML><BODY>"
	
		   sContextEnd = "</BODY></HTML>"
	
		   sHtmlFragment = "<a href='" + link + "'>" + text + "</a>"
	
		   sContextStart = sContextStart & "<!--StartFragment -->"
	
		   sContextEnd = "<!--EndFragment -->" & sContextEnd
	
		   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"))
	
		   b = StrConv(sData, vbFromUnicode, vbUnicode)
	
		   doClipboard.SetText b, "HTML Format"
	
		   doClipboard.PutInClipboard
	
		End Sub