Edit my TruncPath macro

[Karen Clark]

Here's my existing code, which places the
FolderName\FileName (without the entire path, and without
the .doc file extension) at the end of the document in 7
pt. font, and then returns the cursor to it's original
place in the document:

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Sub TruncPath()

Dim strFile As String
Dim strPath As String
Dim intLen As Integer
Dim intNumSlash As Integer
Dim strShortPath As String
Dim strFinal As String
Dim rngPlaceHolder As Range

strFile = Left(ActiveDocument.Name, Len
(ActiveDocument.Name) - 4)
strPath = ActiveDocument.Path
intLen = Len(strPath)
intNumSlash = InStrRev(strPath, "\")
strShortPath = Right(strPath, intLen - intNumSlash)
strFinal = strShortPath & "\" & strFile

Set rngPlaceHolder = Selection.Range
Selection.EndKey Unit:=wdStory
Selection.Font.Size = 7
Selection.TypeText Chr(13) & strFinal & Chr(13)
rngPlaceHolder.Select


End Sub

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Can someone please help me change the code so it places
the same information in the footer on the last page of the
document (instead of at the end of the document)?

Thank you so much for your help.

Karen

 

[Greg]

Karen,

This is gnarly but seems to work with a simple one section document.
Basically all I did was go to the footer and record a macro of the
steps to enter an IF field
(e,g, IF Page = NumPages"Insert Some Text") and applied the *\
Charformat switch so that the field result will display in the format
of the first character in the field. Next I just plugged in your sting
in the "Insert Some Text" and viola!!

You can probably play with the code some and clean it up a bit:

Sub TruncPath()

Dim strFile As String
Dim strPath As String
Dim intLen As Integer
Dim intNumSlash As Integer
Dim strShortPath As String
Dim strFinal As String
Dim rngPlaceHolder As Range


strFile = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)
strPath = ActiveDocument.Path
intLen = Len(strPath)
intNumSlash = InStrRev(strPath, "\")
strShortPath = Right(strPath, intLen - intNumSlash)


strFinal = strShortPath & "\" & strFile
Set rngPlaceHolder = Selection.Range
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="IF "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="Page"
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.TypeText Text:=" = "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="NumPages"
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.TypeText Text:="" & strFinal & ""
Selection.TypeText Text:="\* Charformat"
Selection.MoveLeft Unit:=wdCharacter, Count:=51
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
With Selection.Font
..Size = 7
End With
rngPlaceHolder.Select


End Sub

 

[Greg]

Karen,

I think this might be a better way. Insert a field in your footer:

{ IF {PAGE } = { NUMPAGES } { DOCVARIABLE "Path" } \* Charformat}

Note: Format the "I" in "IF" as 7 point font

Now try this macro:
Sub TruncPath()

Dim strFile As String
Dim strPath As String
Dim intLen As Integer
Dim intNumSlash As Integer
Dim strShortPath As String
Dim strFinal As String
Dim rngPlaceHolder As Range


strFile = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)
strPath = ActiveDocument.Path
intLen = Len(strPath)
intNumSlash = InStrRev(strPath, "\")
strShortPath = Right(strPath, intLen - intNumSlash)


strFinal = strShortPath & "\" & strFile

ActiveDocument.Variables.Add Name:="Path", Value:=strFinal
ActiveDocument.Fields.Update


End Sub

 

[Greg Maxey]

Karen,

I have monkeyed around with your question a bit more and I think that I have
it streamlined. A true expert may be along to suggest that I don't
continually modify the same string. We will see

Sub TruncPath()

Dim oStory As Range
Dim myString As String

myString = ActiveDocument.FullName
myString = Left(myString, InStrRev(myString, ".") - 1)
myString = Right(myString, (Len(myString) - (Len(myString) _
- (InStrRev(myString, "\") - 1))))

On Error Resume Next
ActiveDocument.Variables.Add Name:="Path", Value:=myString
ActiveDocument.Variables("Path").Value = myString
For Each oStory In ActiveDocument.StoryRanges
oStory.Fields.Update
Next oStory

End Sub

 

[Greg Maxey]

Karen,

I had to go back to the drawing board. After further testing I realized
that I had streamlined too much. I tried to cancel the erroneous mesage,
but I don't know if will be removed before you view the posting. Sorry for
any confusion. Here is what I have now:
Sub TruncPath()

Dim oStory As Range
Dim MyFile As String
Dim MyPath As String
Dim myString As String

MyFile = ActiveDocument.Name
MyFile = Left(ActiveDocument.Name, InStrRev(MyFile, ".") - 1)
MyPath = ActiveDocument.Path
MyPath = Right(MyPath, Len(MyPath) - (InStrRev(MyPath, "\")))

myString = MyPath & "\" & MyFile

On Error Resume Next
ActiveDocument.Variables.Add Name:="Path", Value:=myString
ActiveDocument.Variables("Path").Value = myString
For Each oStory In ActiveDocument.StoryRanges
oStory.Fields.Update
Next oStory

End Sub