AvBrand.com - Blog - Adding a 'Paste Code' feature to Outlook 2010/2007

AvBrand Exploring Technology

Blog

< Back to Blog

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.

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.
Click the orange 'File', then 'Options'.
Go down to 'Trust Center', then 'Trust Center Settings'
Select the 'Macro Settings' tab
Select 'Enable all macros', and click OK.

Now we need to enable the developer mode.
Right-click somewhere in the Ribbon and select 'Customize the Ribbon'.
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.
Click OK to close the window.

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

We need to add a reference we're going to be using.
Click the 'Tools' menu, then 'References'
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.
Click OK.

Now we're ready to start adding the code.
Expand the Project on the right and double-click the file 'ThisOutlookSession'. A blank code window should appear.

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

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
    fm.GetFromClipboard
    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
                    ActiveInspector.WordEditor.Application.Selection.Paste
                End If
            End If
            
        End If
        
    End If
    
    Debug.Print "Paste Code Complete"
errHandler:
    
 
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
                  EmptyClipboard
                  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
        Else
            Escape = Replace(Escape, Chr(i), "%" & fixZeros(Hex(i)))
        End If
    Next
    
 
End Function

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
Save and close the VB Editor window.

Finally, we need to create the buttons in the email window.
Open an email compose or reply window.
Right-click the Ribbon and select 'Customize the Ribbon'
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'.
On the left side, change the dropdown from 'Popular Commands' to 'Macros'.
You should see a bunch of 'Project1.ThisOutlookSession.PasteJS', etc. Select each one and click 'Add' to bring it over into your new group.
Click Rename to clean up the messy name and make it clean, like 'Paste JS'.
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:

Comments

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!

Thanks

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
Next
Next

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

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.
cheers.

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

Comments

Comments Closed