AvBrand Exploring Technology
AvBrand Exploring Technology

Adding a 'Paste Code' feature to Outlook 2010/2007

8:20 AM, April 17th, 2012

I recently switched to Outlook for my corporate email, and one of the biggest features I missed that I had as a Thunderbird extension was the 'Paste Code' ability. When I shared code with my coworkers, I'd use Paste Code to pretty it up and add syntax highlighting and formatting.

So, here's how to set this up in Outlook.

  1. First we need to enable Macros. You can tune your security settings as you like, but for now we're just going to enable them.
  2. Click the orange 'File', then 'Options'.
  3. Go down to 'Trust Center', then 'Trust Center Settings'
  4. Select the 'Macro Settings' tab
  5. Select 'Enable all macros', and click OK.

    Now we need to enable the developer mode.
  6. Right-click somewhere in the Ribbon and select 'Customize the Ribbon'.
  7. On the right side list, under Main Tabs, there should be a tab called Developer. Make sure the tab has a checkbox next to it.
  8. Click OK to close the window.

    A new 'Developer' tab has appeared on the main Ribbon of Outlook.
  9. Click the 'Developer' tab.
  10. Now click the 'Visual Basic' button to bring up the VB Editor.

    We need to add a reference we're going to be using.
  11. Click the 'Tools' menu, then 'References'
  12. Click 'Browse', then type 'FM20.DLL' and press OK. This is the Microsoft Forms 2.0 Library, if you don't have FM20.DLL you might be able to download it from somewhere.
  13. Click OK.

    Now we're ready to start adding the code.
  14. Expand the Project on the right and double-click the file 'ThisOutlookSession'. A blank code window should appear.
  15. Paste the following code at the top of the file:

    Option Explicit

    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 m_cfHTMLClipFormat As Long

    Private Const m_sDescription = _
    "Version:1.0" & vbCrLf & _
    "StartHTML:aaaaaaaaaa" & vbCrLf & _
    "EndHTML:bbbbbbbbbb" & vbCrLf & _
    "StartFragment:cccccccccc" & vbCrLf & _
    "EndFragment:dddddddddd" & vbCrLf

  16. Next, paste the following code at the bottom of the file (if you already had stuff in the file)

    Public Sub PasteVB()
    PasteCode "vbasic"
    End Sub
    Public Sub PasteJS()
    PasteCode "jScript"
    End Sub

    Private Sub PasteCode(mLanguage As String)

    ' Paste code into the message window.

    Dim req
    Dim URL
    Dim f
    Dim r As String
    Dim e, e2
    Dim origT As String

    Debug.Print "Starting Paste Code"

    URL = "http://tohtml.com/" & mLanguage & "/"

    ' Retrieve text from the clipboard
    Dim fm As MSForms.DataObject
    Set fm = New MSForms.DataObject
    r = fm.GetText(1) ' Text
    origT = r

    If r <> "" Then
    ' Get the code colorized by tohtml.com
    f = "style=navy"
    f = f & "&type=" & Escape(mLanguage)
    f = f & "&Submit=Highlight"
    f = f & "&code_src=" & Escape(r)

    Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
    req.Open "POST", URL, False
    req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    req.Send f

    r = req.responsetext

    ' Extract the response
    e = InStr(1, r, "<textarea", vbTextCompare)
    e = InStr(e + 1, r, ">")
    e2 = InStr(e + 1, r, "</textarea>", vbTextCompare)

    If e > 0 And e2 > e Then

    r = Mid(r, e + 1, e2 - e - 1)

    ' Fix the HTML code
    r = Replace(r, "&gt;", ">")
    r = Replace(r, "&lt;", "<")
    r = Replace(r, "&apos;", "'")
    r = Replace(r, "&quot;", """")
    r = Replace(r, "&amp;", "&")

    PutHTMLClipboard r, origT

    ' Paste into current message
    On Error GoTo errHandler
    If TypeName(ActiveWindow) = "Inspector" Then
    If ActiveInspector.IsWordMail And ActiveInspector.EditorType = olEditorWord Then
    End If
    End If

    End If

    End If

    Debug.Print "Paste Code Complete"

    End Sub

    Private 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

    Private Sub PutHTMLClipboard(sHtmlFragment As String, textVersion As String, Optional sContextStart As String = "<HTML><BODY>", Optional sContextEnd As String = "</BODY></HTML>")

    Dim sData As String

    If RegisterCF = 0 Then Exit Sub ' If we can't register the clipboard handle, then cancel.

    'Add the starting and ending tags for the HTML fragment
    sContextStart = sContextStart & "<!--StartFragment -->"
    sContextEnd = "<!--EndFragment -->" & 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"))

    textVersion = textVersion & Chr(0)

    'Add the HTML code to the clipboard
    If CBool(OpenClipboard(0)) Then

    Dim hMemHandle As Long, lpData As Long
    If sHtmlFragment <> "" Then
    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
    SetClipboardData m_cfHTMLClipFormat, hMemHandle
    End If
    End If
    End If

    hMemHandle = GlobalAlloc(0, Len(textVersion) + 10)

    If CBool(hMemHandle) Then
    lpData = GlobalLock(hMemHandle)
    If lpData <> 0 Then
    CopyMemory ByVal lpData, ByVal textVersion, Len(textVersion)
    GlobalUnlock hMemHandle
    If sHtmlFragment = "" Then EmptyClipboard
    SetClipboardData 1, hMemHandle
    End If
    End If

    Call CloseClipboard
    End If

    End Sub

    Private Function fixZeros(inSt)
    ' Adds a 0 to the front if needed.
    fixZeros = inSt
    If Len(fixZeros) = 1 Then fixZeros = "0" & fixZeros
    End Function
    Private Function Escape(inTxt)

    ' Escape the text.
    Dim i
    Dim outText

    outText = inTxt
    Escape = outText

    Escape = Replace(Escape, "%", "%25")
    For i = 1 To 255
    If i = 37 Then
    ' skip %
    ElseIf i >= 65 And i <= 90 Then
    ' A-Z
    ElseIf i >= 97 And i <= 122 Then
    ' a-z
    ElseIf i >= 48 And i <= 57 Then
    ' 0-9
    Escape = Replace(Escape, Chr(i), "%" & fixZeros(Hex(i)))
    End If

    End Function

  17. If you want to support more languages, copy this section here and rename it, and put in the language ID from www.tohtml.com that you need. For example, here is the code for C#:

    Public Sub PasteCSharp()
    PasteCode "csharp"
    End Sub

  18. Save and close the VB Editor window.

    Finally, we need to create the buttons in the email window.
  19. Open an email compose or reply window.
  20. Right-click the Ribbon and select 'Customize the Ribbon'
  21. Select the first tab on the list on the right and then click 'New Group'. Select your new group and rename it to something like 'Paste Code'.
  22. On the left side, change the dropdown from 'Popular Commands' to 'Macros'.
  23. You should see a bunch of 'Project1.ThisOutlookSession.PasteJS', etc. Select each one and click 'Add' to bring it over into your new group.
  24. Click Rename to clean up the messy name and make it clean, like 'Paste JS'.
  25. Click OK to save your changes, copy some Code from somewhere, and paste it into the email using those buttons.

You're finally done! Here's how it should look when you're all finished:


Mark 8:39 AM, November 13th, 2014

Just wanted to say thanks so much for this, as a developer I hate the way code is formatted in Outlook and this just looks so much better!


James Treworgy 8:11 AM, June 3rd, 2015

Thanks for this nice little hack to something that always annoyed me. I made a trivial improvement to automatically left-align the code (e.g. since often you copy from within a code block). This doesn't autoformat or anything, so if the3 code was badly formatted to begin with it will remain badly formatted, it simply normalizes the indentation so the leftmost indented line has no leading spaces. It probably won't work with tabs. Add this below the line "origT = r". (It sure has been a long time since I did any VB

Dim lines() As String
lines = Split(r, vbCrLf)

Dim line As String
Dim firstChar As Integer

Dim i, j As Integer

For i = 0 To UBound(lines)
line = lines(i)

For j = 1 To Len(line)
If Mid(line, j, 1) <> " " Then
firstChar = j
Exit For
End If

For i = 0 To UBound(lines)
lines(i) = Mid(lines(i), firstChar)

r = Join(lines, vbCrLf)

Jun 8:29 AM, August 27th, 2015

Clear instructions, thanks!

Surry 8:01 PM, October 13th, 2015

Hi there,
Great article here. I've got it working in outlook. So thanks for sharing.

Is it possible to choose different styles for different code types? This would be really handy. I only got as far as changing the style from navy to bred3, and adding a few more code types. Would be great to set it per code type.

copyright © 2024 AvBrand.com - sitemap