Macro for automatically adding filename without .doc

[RPM7]

I have a document that I would like to embed the filename into th
header.
The first page of the document has a blank header & the second page ha
the same header as the remainder of the document.
I initially inserted the field [file name] with Uppercase but i
included the ".doc" at the end which I would like to remove. I looke
online and most sites say this can't be done. (Plus the field must b
updated to take effect)
Instead is it possible to insert a macro that upon saving the fil
would create a text box in both headers with the filename and the las
4 letters omitted to remove the ".doc".

Does anyone know anything about this?
I'd appreciate any help at all. Thanks

 

[Steve Yandl]

The subroutine below assumes a document with only one section and will
insert the file name in upper case without the file extension as the left
header on pages 2 and beyond. I didn't take the time to see if this could
be integrated with a sub that intercepts the fileSaveAs normal save and
follows the save with a header update and new save but that might be your
next step.

Steve Yandl

' ----------------------------------------------------------

Sub BaseFileNameHeader()

Dim fso
Dim strFileBaseName As String

Set fso = CreateObject("Scripting.FileSystemObject")
strFileBaseName = fso.GetBaseName(ActiveDocument.Name)
strFileBaseName = UCase(strFileBaseName)

With ActiveDocument.Sections(1)
.PageSetup.DifferentFirstPageHeaderFooter = True
.Headers(1).Range.Text = strFileBaseName
.Headers(wdHeaderFooterFirstPage).Range.Text = ""
End With

Set fso = Nothing

End Sub

' -------------------------------------------------------------