|
|
|
UER Store
|
|
order your copy of Access All Areas today!
|
|
|
|
Activity
|
|
468 online
Server Time:
2024-04-24 11:16:34
|
|
|
| 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 125 milliseconds. Since June 23, 2002, a total of 738896591 pages have been generated.
|
|