Insert a ftr or macro into email saved to .doc w/o opening doc fi

Insert a ftr or macro into email saved to .doc w/o opening doc fi

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

date: Sun, 1 Jun 2008 08:52:00 -0700 author: Marceepoo alias

Re: Insert a ftr or macro into email saved to .doc w/o opening doc fi

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" <36c53a08-2073470544@news.postalias> wrote in message news:15E9D158-C5EA-4A6A-943A-22B0C89659CC@microsoft.com...
> 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
>

date: Sun, 1 Jun 2008 14:24:47 -0400 author: Sue Mosher [MVP-Outlook]