We use a macro in Outlook 2003 and 2007 to save e-mails to .htm files, and
then to rename each email file so that it has a .doc extension.

Without opening Word (each time the Outlook macro saves an email), I want to
insert a footer into each saved e-mail (i.e., the footer would have the Word
filename field at the left margin in 8pt TimesRoman font, and the pagenumber
centered in Times 13. An example of a macro we use in Word "FtrPrimitive01"
is set forth below, at the bottom of this posting.).

I am having trouble figuring out how to add code to the Outlook VBA that
would carry out any of the following alternative solutions for getting to the
same result:

1. Manually insert a footer into each saved e-mail (i.e., carry out the
actions shown in the sub "FtrPrimitive01" shown below); OR
2. Copy a footer from another document (e.g., k:\data\forms\footer.doc)
into the saved e-mail; OR
3. Attach a macro (somehow) to the saved .doc file (e.g., a macro that
would create a footer when the document is opened).

I would appreciate any possible coding solutions, and any references to URLs
where I could learn how to carry out the solutions indicated above.

Thank you in advance for taking the time to read this and for any suggestions.


Marceepoo

Here's a footer macro we use:

Sub FtrPrimitive01()
'
' Macro9 Macro
' Macro recorded 6/1/2008 by Marc B. Hankin
'
' If ActiveWindow.View.SplitSpecial wdPaneNone Then
' ActiveWindow.Panes(2).Close
' End If
' If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
' ActivePane.View.Type = wdOutlineView Then
' ActiveWindow.ActivePane.View.Type = wdPrintView
' End If
' ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
' If Selection.HeaderFooter.IsHeader = True Then

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

' Else
' ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
' End If

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"FILENAME \* Caps \p ", PreserveFormatting:=True
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
With Selection.Font
.Name = "Times New Roman"
.Size = 8
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Font.Size = 13
Selection.EscapeKey
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.TypeText Text:= _
" "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

By "footer" do you mean a footer for each page? The only way to do that is to use Word methods to open the document and insert a footer using the same sort of code that you already have:

Set objWord = CreateObject("Word.Application
Set objDoc = objWord.Open("c:\your file name.htm")
' run footer code you already have against objDoc.Selection instead of Selection

You can then call objDoc.SaveAs to save the .htm file as a Word .doc file

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"Marceepoo" wrote in message ...
We use a macro in Outlook 2003 and 2007 to save e-mails to .htm files, and
then to rename each email file so that it has a .doc extension.

Without opening Word (each time the Outlook macro saves an email), I want to
insert a footer into each saved e-mail (i.e., the footer would have the Word
filename field at the left margin in 8pt TimesRoman font, and the pagenumber
centered in Times 13. An example of a macro we use in Word "FtrPrimitive01"
is set forth below, at the bottom of this posting.).

I am having trouble figuring out how to add code to the Outlook VBA that
would carry out any of the following alternative solutions for getting to the
same result:

1. Manually insert a footer into each saved e-mail (i.e., carry out the
actions shown in the sub "FtrPrimitive01" shown below); OR
2. Copy a footer from another document (e.g., k:\data\forms\footer.doc)
into the saved e-mail; OR
3. Attach a macro (somehow) to the saved .doc file (e.g., a macro that
would create a footer when the document is opened).

I would appreciate any possible coding solutions, and any references to URLs
where I could learn how to carry out the solutions indicated above.

Thank you in advance for taking the time to read this and for any suggestions.


Marceepoo

Here's a footer macro we use:

Sub FtrPrimitive01()
'
' Macro9 Macro
' Macro recorded 6/1/2008 by Marc B. Hankin
'
' If ActiveWindow.View.SplitSpecial wdPaneNone Then
' ActiveWindow.Panes(2).Close
' End If
' If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
' ActivePane.View.Type = wdOutlineView Then
' ActiveWindow.ActivePane.View.Type = wdPrintView
' End If
' ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
' If Selection.HeaderFooter.IsHeader = True Then

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

' Else
' ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
' End If

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"FILENAME \* Caps \p ", PreserveFormatting:=True
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
With Selection.Font
.Name = "Times New Roman"
.Size = 8
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Font.Size = 13
Selection.EscapeKey
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.TypeText Text:= _
" "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub