 |
|
|
UER Store
|
|
sweet UER decals:
|
|
|
|
Activity
|
|
572 online
Server Time:
2024-04-18 23:40:25
|
|
|
 | Adding a 'Paste Code' feature to Outlook 2010/2007
entry by Avatar-X
4/17/2012 1:20 PM
| 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, ">", ">")
r = Replace(r, "<", "<")
r = Replace(r, "'", "'")
r = Replace(r, """, """")
r = Replace(r, "&", "&")
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:
[last edit 4/17/2012 1:21 PM by Avatar-X - edited 1 times]
Modify Entry |
|
Comments: (use Reply to add a comment) Avbrand Blog Commenter
Comments from the AvBrand Blog
Total Likes: 3 likes
 |  |  | AvBrand Blog Comment: James Treworgy
< Reply # 2 on 6/3/2015 1:11 PM >
| Reply with Quote
| | | 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)
|
|
|
| This thread is in a public category, and can't be made private. |
|
All content and images copyright © 2002-2024 UER.CA and respective creators. Graphical Design by Crossfire.
To contact webmaster, or click to email with problems or other questions about this site:
UER CONTACT
View Terms of Service |
View Privacy Policy |
Server colocation provided by Beanfield
This page was generated for you in 62 milliseconds. Since June 23, 2002, a total of 738447165 pages have been generated.
|
|
