Peter Farley asked:
>Any chance you could share the Outlook macro or tell me how to set it
>up myself? My corporate Outlook does this for LISTSERV emails and it
>can be very tedious to "correct" it.
OK, you asked for it! This is definitely OT for IBM-MAIN but, I hope, harmless.
If anyone objects, you have my humblest apologies and I will say three Hail
Darrens.
Here are all the Outlook macros I have developed over the last 25+ years. I
don't claim to be Mr. VBA, so if anyone has suggestions for improvements, email
me off-list (just to keep the noise down for others) please. I'm including them
all because the knowledge to create them was VERY hard-won: there really isn't
a lot of documentation that I've found. So they may prove useful for someone
else.
To add the macros to Outlook, hit <Alt><F11> in Outlook and paste into the
right pane. Then you need to hit F5 and run
ThisOutlookSession.Application_Startup to activate them. Actually you may not
need to do that for just the one you asked for, but it's harmless at least.
You'll also need to add the Word object model to Outlook by clicking
Tools/References in the macro editor and checking the box next to "Microsoft
Word nn Object Library". I only learned about this recently, when doing this
hard-linend-to-soft, which will make future macros a LOT easier, I think; the
Outlook object model is much more limited. (Thanks to Diane at slipstick.com
for telling me about it--that's a great site if you're into Outlook.)
A bunch of this stuff (all the xxxx_ItemAdd functions and subsequent
myXxxxxItems events [not even sure "function" and "events" are the right
terms?]) relate to me wanting to avoid having unread items in Deleted Items
folders. You'll note that there are specific mailbox names in those
definitions, so other than the one for the default folder, these won't work
as-is. This isn't JUST OCD-ness, it's that I find it much easier to tell at a
glance among my dozen-plus accounts which ones have new stuff if I don't have
to see the Deleted Items folders also in bold.
Those mark-read-on-delete macros also do some tinkering with Categories. This
is because a while ago our corporate IT let a virus through. Once they realized
that, they scanned everyone's Deleted Items in Exchange to look for the
offending note and, if it was in there and marked read, shook their finger at
you. I had deleted it unread but had no way to prove that; now such notes get
*Autoread added as a category so I can say "No, stop, calm down" if it happens
again (which of course it hasn't, because that's how things go).
The other macros that are triggered manually I have on the Quick Access toolbar
so I can run them via keyboard shortcuts (<alt>+<a_number>). And how do you do
THAT? By (FROM A NOTE, not the Inbox) right-clicking on the Ribbon; selecting
Customize Ribbon, then Quick Access Toolbar on the left; then in the "Choose
commands from:" box going to Macros; finding the one you want; and
double-clicking it so it copies to the right. Then click Modify and select an
icon--there are a bunch but they're not necessarily what you want, but that's
all you get. Once you OK your way out of there, you can invoke the macro with
<alt><n> where <n> is the position of the macro, origin 1. So you have to
remember "My macro to do x is <alt>4" or whatever. Not wonderful; in Word and
friends, you can set them to things like <alt><cntrl><letter>, which at least
can be a bit mnemonic. If you don't want to bother, <alt><F8> brings up the
list of macros and you can run one from there.
The macros I have defined are:
PastePlain -- what it sounds like: do a Paste Unformatted
XMP -- convert selected text to Courier New, black, bolded
TimesBlack -- convert selected text to Times New Roman, black
NormalSpacing -- get rid of funky spacing
P2L -- what you actually asked for: change ^p to ^l. It does so in the entire
note; it hasn't irritated me enough to make it just do it in selected text.
Finally, XSetCustomFlag is something I'm tinkering with, to do with automating
setting a reminder on Kindle library notices. Ignore it.
Once you have stuff working, I highly recommend doing <alt><F11> and copying
the macros somewhere else as a backup. I put mine in an Outlook "sticky note",
as well as on disk. This way if you muck 'em up they're easy to recover (no
points for guessing why I'm paranoid about this!)
The VBA code is below. I hope this helps and isn't too daunting.
====================================================
Public WithEvents myDelItems As Outlook.Items
Public WithEvents myPhs3POPItems As Outlook.Items
Public WithEvents myAkphsPOPItems As Outlook.Items
Public WithEvents myCalendarItems As Outlook.Items
Public WithEvents myJunkItems As Outlook.Items
Public WithEvents myJunkPhs3Items As Outlook.Items
Public WithEvents myJunkAkphsItems As Outlook.Items
Public Sub Application_Startup()
Dim popFolder As Outlook.Folder
Set myDelItems = Outlook.Session.GetDefaultFolder(olFolderDeletedItems).Items
Set objNS = Application.GetNamespace("MAPI")
Set popFolder = objNS.Folders("p...@cox.net")
Set myPhs3POPItems = popFolder.Folders("Deleted Items").Items
Set popFolder = objNS.Folders("ak...@cox.net")
Set myAkphsPOPItems = popFolder.Folders("Deleted Items").Items
Set myCalendarItems =
Outlook.Session.GetDefaultFolder(olFolderCalendar).Items
Set myJunkItems = Outlook.Session.GetDefaultFolder(olFolderJunk).Items
Set objNS = Application.GetNamespace("MAPI")
Set popFolder = objNS.Folders("p...@cox.net")
Set myJunkPhs3Items = popFolder.Folders("Junk E-mail").Items
Set popFolder = objNS.Folders("ak...@cox.net")
Set myAkphsPOPItems = popFolder.Folders("Deleted Items").Items
Set myJunkAkphsItems = popFolder.Folders("Junk E-mail").Items
End Sub
Private Sub myDelItems_ItemAdd(ByVal Item As Object)
Dim Categories As String
' MsgBox (Item.UnRead)
' MsgBox (TypeName(Item))
If TypeName(Item) = "MailItem" Or TypeName(Item) = "MeetingItem" Or
TypeName(Item) = "AppointmentItem" Then
If Item.UnRead = True Then Item.UnRead = False 'Mark
the message read
Categories = Item.Categories
If InStr(1, Categories, "*Autoread") = 0 Then
Item.Categories = Categories + ",*Autoread"
End If
Item.Save
End If
End Sub
Private Sub myPhs3POPItems_ItemAdd(ByVal Item As Object)
Dim Categories As String
' MsgBox (Item.UnRead)
If TypeName(Item) = "MailItem" Or TypeName(Item) = "MeetingItem" Or
TypeName(Item) = "AppointmentItem" Then
If Item.UnRead = True Then
If TypeName(Item) = "MailItem" Then
Item.UnRead = False 'Mark the message read
Categories = Item.Categories
If InStr(1, Categories, "*Autoread") = 0 Then
Item.Categories = Categories + ",*Autoread"
End If
Item.Save
End If
End If
End If
End Sub
Private Sub myAkphsPOPItems_ItemAdd(ByVal Item As Object)
If TypeName(Item) = "MailItem" Then
Item.UnRead = False 'Mark the message read
End If
End Sub
Private Sub myJunkItems_ItemAdd(ByVal Item As Object)
Dim objNS As NameSpace
Dim objSF As MAPIFolder
'Mark the message as Junk
If Item.Categories = "" Then
Item.Categories = "ExchangeJunk"
Else
Item.Categories = Item.Categories & ", ExchangeJunk"
End If
Item.Save
'Now move it to the "SpamItems" folder in the Spam PST
Set objNS = Application.GetNamespace("MAPI")
Set objSF = objNS.Folders("Spam").Folders.Item("SpamItems")
Item.Move objSF
End Sub
Private Sub myJunkPhs3Items_ItemAdd(ByVal Item As Object)
Dim objNS As NameSpace
Dim objSF As MAPIFolder
'Mark the message as Junk
If Item.Categories = "" Then
Item.Categories = "PopJunk"
Else
Item.Categories = Item.Categories & ", POPJunk"
End If
Item.Save
'Now move it to the "SpamItems" folder in the Spam PST
Set objNS = Application.GetNamespace("MAPI")
Set objSF = objNS.Folders("Spam").Folders.Item("SpamItems")
Item.Move objSF
End Sub
Private Sub myJunkAkphsItems_ItemAdd(ByVal Item As Object)
Dim objNS As NameSpace
Dim objSF As MAPIFolder
'Mark the message as Junk
If Item.Categories = "" Then
Item.Categories = "PopJunk"
Else
Item.Categories = Item.Categories & ", POPJunk"
End If
Item.Save
'Now move it to the "SpamItems" folder in the Spam PST
Set objNS = Application.GetNamespace("MAPI")
Set objSF = objNS.Folders("Spam").Folders.Item("SpamItems")
Item.Move objSF
End Sub
Private Sub myCalendarItems_ItemAdd(ByVal Item As Object)
Dim Categories As String
If Item.UnRead = True Then
If TypeName(Item) = "AppointmentItem" Then
Item.UnRead = False 'Mark the item read
Categories = Item.Categories
If InStr(1, Categories, "*Autoread") = 0 Then
Item.Categories = Categories + ",*Autoread"
End If
Item.Save
End If
End If
End Sub
Sub PastePlain()
On Error GoTo ErrHandler
If TypeName(ActiveWindow) = "Inspector" Then
' MsgBox (olEditorWord)
If ActiveInspector.IsWordMail And ActiveInspector.EditorType =
olEditorWord Then
ActiveInspector.WordEditor.Application.Selection.PasteSpecial
DataType:=2 ' wdPasteText, only not
End If
End If
Exit Sub
ErrHandler:
Beep
End Sub
Sub XMP()
Set objDoc = Application.ActiveInspector.WordEditor
' MsgBox (olEditorWord)
Set objSel = objDoc.windows(1).Selection
' MsgBox (olEditorWord)
objSel.Font.Name = "Courier New"
objSel.Font.Color = wdColorBlack
objSel.Font.Bold = True
End Sub
Sub TimesBlack()
Set objDoc = Application.ActiveInspector.WordEditor
Set objSel = objDoc.windows(1).Selection
objSel.Font.Name = "Times New Roman"
objSel.Font.Color = wdColorBlack
End Sub
Sub XSetCustomFlag()
Dim objMsg As Object
' GetCurrent Item function is at http://slipstick.me/e8mio
Set objMsg = GetCurrentItem()
With objMsg
' No date yet
.MarkAsTask olMarkNoDate
' Sets a specific due date and time: 2 days hence, 4PM
.TaskDueDate = Now + 2
.TaskStartDate = Now + 2
.FlagRequest = "Library book!"
.ReminderSet = True
.ReminderTime = Date + 2.6666
.Save
End With
Set objMsg = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
Sub NormalSpacing()
Dim objOL As Application
Dim objDoc As Object
Dim objSel As Object
Set objOL = Application
Set objDoc = objOL.ActiveInspector.WordEditor
Set objSel = objDoc.windows(1).Selection
objSel.ParagraphFormat.SpaceBefore = 0
objSel.ParagraphFormat.SpaceBeforeAuto = False
objSel.ParagraphFormat.SpaceAfter = 0
objSel.ParagraphFormat.SpaceAfterAuto = False
objSel.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
objSel.ParagraphFormat.FirstLineIndent = 0
objSel.ParagraphFormat.LeftIndent = 0
objSel.ParagraphFormat.RightIndent = 0
Set objOL = Nothing
Set objDoc = Nothing
Set objSel = Nothing
End Sub
Public Sub P2L()
' Use the top part – down to the Set objSel = objWord.Selection line -
' and the end, beginning with the 3 End If’s, as a template for working
' with the Word object model in outlook.
Dim objItem As Object
Dim objInsp As Outlook.Inspector
' Add reference to Word library
' in VBA Editor, Tools, References
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
On Error Resume Next
'Reference the current Outlook item
Set objItem = Application.ActiveInspector.CurrentItem
If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
' replace the With block with your code
objSel.Find.ClearFormatting
objSel.Find.Replacement.ClearFormatting
With objSel.Find
.Text = "^p"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
objSel.Find.Execute Replace:=wdReplaceAll
End If
End If
End If
Set objItem = Nothing
Set objWord = Nothing
Set objSel = Nothing
Set objInsp = Nothing
End Sub
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
