edit specific field code in footer only

[WallIT]

Hi,

Many of our word documents have a field code of {FILENAME \p \* MERGEFORMAT} in the footer (usually in the footer of all sections). This would show the full path and document name, such as N:\Docs\Client\Letters\doc1.docx.

We have recently migrated to a new Document Management System which uses a custom document property ("DMSFooter", the value of which is the unique document number eg "12345678"). We would like to replace the old footer with the new one, so it only shows the unique document number.

I have read http://gregmaxey.mvps.org/word_tip_pages/field_macros.html, which provides some helpful examples. I am using the example below and I have modified it slightly to find the wdFieldFileName field type. I have also modified the code to delete the field. However, rather than deleting, I would prefer to simply change the field code to use the custom document property "DMSFooter" instead.


Sub TargetSpecificTargetInSpecificFields()Dim rngStory As Word.Range
Dim oFld As Word.Field
Dim iLink As Long
iLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each rngStory In ActiveDocument.StoryRanges
Do
For Each oFld In rngStory.Fields
Select Case oFld.Type
Case wdFieldFileName
'Dig a little deeper and see what the field code contains.
'original code - If InStr(oFld.Code.Text, "Author") Then
oFld.Delete
'End If
Case Else
'Do nothing
End Select
Next
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
lbl_Exit:
Exit Sub
End Sub

Any help is gratefully received. Also, I haven't actually run the code yet, but instead "stepped into" the code and I notice if I hold the F8 key down, the code loops continuously, never reaching the exit. How can I prevent this? Also, to make it more efficient, is it possible to only target footers and not headers, the main body, or any other part of a document?

Kind regards

[gmayor]

The following modification will replace the Filename field in any footer range in the document with the named DocProperty field



Sub TargetSpecificTargetInSpecificFields()
Dim oFld As Word.field
Dim oSection As Section
Dim oFooter As HeaderFooter
Dim orng As Range
For Each oSection In ActiveDocument.Sections
For Each oFooter In oSection.Footers
If oFooter.Exists Then
For Each oFld In oFooter.Range.Fields
If oFld.Type = wdFieldFileName Then
Set orng = oFld.Result
oFld.Delete
orng.Fields.Add orng, wdFieldDocProperty, "DMSFooter", False
End If
Next oFld
End If
Next oFooter
Next oSection
lbl_Exit:
Exit Sub
End Sub

[WallIT]

Thanks Graham,

I notice the current field gets deleted and a new one created. Normally this would be fine but the new field is a different font and size to the one it replaces, so looks odd. I either need to be able to set the font and size of the new field, or simply replace the existing field type with the new type, so it preserves the formatting.

In trying to edit the font I have added a few lines below, which does not throw any errors, but does not work either.


Sub TargetSpecificTargetInSpecificFields()
Dim oFld As Word.Field
Dim oSection As Section
Dim oFooter As HeaderFooter
Dim orng As Range
For Each oSection In ActiveDocument.Sections
For Each oFooter In oSection.Footers
If oFooter.Exists Then
For Each oFld In oFooter.Range.Fields
If oFld.Type = wdFieldFileName Then
Set orng = oFld.Result
oFld.Delete
orng.Fields.Add orng, wdFieldDocProperty, "DMSFooter", False
orng.Font.Size = 8
orng.Font.Name = "Arial"
End If
Next oFld
End If
Next oFooter
Next oSection
lbl_Exit:
Exit Sub
End Sub

[gmayor]

It doesn't work because the field is inserted after the range, so you need to move the range to encompass the field before you can format it. e.g.



Sub TargetSpecificTargetInSpecificFields()
Dim oFld As Word.field
Dim oNewFld As Word.field
Dim oSection As Section
Dim oFooter As HeaderFooter
Dim orng As Range
For Each oSection In ActiveDocument.Sections
For Each oFooter In oSection.Footers
If oFooter.Exists Then
For Each oFld In oFooter.Range.Fields
If oFld.Type = wdFieldFileName Then
Set orng = oFld.Result
oFld.Delete
Set oNewFld = orng.Fields.Add(orng, wdFieldDocProperty, "DMSFooter", False)
Set orng = oNewFld.Result
orng.Font.Size = 8
orng.Font.name = "Arial"
End If
Next oFld
End If
Next oFooter
Next oSection
lbl_Exit:
Exit Sub
End Sub