replace field in primary header using find and replace in a macro

[SteveB]

OK this is my situation

I can record a macro and as I am recording it the process works fine.
I replace the field function Time with a Createdate one and it does this in
a Primary header's fields aswell as the main document area.

all the fields in question are inside primary headers

upon re-running the macro it fails.

regardless of where I place the cursor prior to running the macro.

please help me - I am in danger of becoming insane over this !

This is the macro


Sub Replacer()
'
' Replacer Macro
' Macro recorded 05/08/2008 by Simun
'
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "TIME"
.Replacement.Text = "CREATEDATE"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
End Sub



Thanks in advance for any help !

Steve

 

[Lene Fredborg]

I am not sure what "fails" means here - does the macro display an error or
does it not change any fields?

Note that if field codes are shown when you start the macro, none of the
fields will be changed due to the code line:

ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes

When field codes are shown, the line toggles the field codes off and TIME is
not found.

Try to replace that line with:

ActiveWindow.View.ShowFieldCodes = True

and the corresponding line at the end of the macro with:

ActiveWindow.View.ShowFieldCodes = False

Does this solve the problem?

Note: You macro will replace any occurrence of the letters “time†with
“createtime†– this may result in undesired replacements in the document. You
may want to use something like the following instead – it iterates though all
stories in the document and checks the fields. If a TIME field is found, it
is changed to a CREATEDATE field:

Sub ReplaceTimeFieldByCreateDateField()

Dim oField As Field
Dim oStory As Range

For Each oStory In ActiveDocument.StoryRanges
If Not oStory Is Nothing Then
For Each oField In oStory.Fields
If oField.Type = wdFieldTime Then
oField.Code.Text = _
Replace(oField.Code.Text, "TIME", "CREATEDATE")
End If
Next oField
End If
Next oStory

End Sub

--
Regards
Lene Fredborg - Microsoft MVP (Word)
DocTools - Denmark
www.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word

 

[Greg Maxey]

I am not sure what "fails" means here - does the macro display an error or
does it not change any fields?

Note that if field codes are shown when you start the macro, none of the
fields will be changed due to the code line:

    ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes

When field codes are shown, the line toggles the field codes off and TIMEis
not found.

Try to replace that line with:

    ActiveWindow.View.ShowFieldCodes = True

and the corresponding line at the end of the macro with:

    ActiveWindow.View.ShowFieldCodes = False

Does this solve the problem?

Note: You macro will replace any occurrence of the letters “time” with
“createtime” – this may result in undesired replacements in the document. You
may want to use something like the following instead – it iterates though all
stories in the document and checks the fields. If a TIME field is found, it
is changed to a CREATEDATE field:

Sub ReplaceTimeFieldByCreateDateField()

    Dim oField As Field
    Dim oStory As Range

    For Each oStory In ActiveDocument.StoryRanges
        If Not oStory Is Nothing Then
            For Each oField In oStory.Fields
                If oField.Type = wdFieldTime Then
                    oField.Code.Text = _
                        Replace(oField.Code.Text,"TIME", "CREATEDATE")
                End If
            Next oField
        End If
    Next oStory

End Sub

--
Regards
Lene Fredborg - Microsoft MVP (Word)
DocTools - Denmarkwww.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word














- Show quoted text -

Lene,

I am sure that your code would be perfectly suitable 99.99% of the
time, but it will miss TIME fields that are contained in the TextRange
of shapes located in headers or footers. This is something that I
discovered when I was working on my VBA Find and Replace AddIn that is
posted on my website. To get them all you would need to process each
shape in the shaperange using something like this:

Sub ScratchMacro()
Dim rngstory As Word.Range
Dim oFld As Word.Field
Dim oShp As Word.Shape
Dim i As Long
'Handle unlinked sections
i = ActiveDocument.Sections(1).Headers(1).Range.StoryType
With ActiveDocument
For Each rngstory In .StoryRanges
'Iterate through all linked stories
Do
For Each oFld In rngstory.Fields
With oFld
If .Type = wdFieldTime Then
.Code.Text = Replace(oFld.Code.Text, "TIME",
"CREATEDATE")
End If
.Update
End With
Next oFld
On Error Resume Next
Select Case rngstory.StoryType
Case 6, 7, 8, 9, 10, 11
'Interate through all shapes in header/footers
If rngstory.ShapeRange.Count > 0 Then
For Each oShp In rngstory.ShapeRange
If oShp.TextFrame.HasText Then
For Each oFld In oShp.TextFrame.TextRange.Fields
With oFld
If oFld.Type = wdFieldTime Then
oFld.Code.Text = _
Replace(oFld.Code.Text, "TIME", "CREATEDATE")
End If
.Update
End With
Next oFld
End If
Next oShp
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next rngstory
End With
End Sub

Thought you would like to know.

 

[Lene Fredborg]

Greg,

Thank you so much. I know you are absolutely right – I have been working
with some similar problems recently. In Steve’s situation, there is a great
chance that none of the Time fields are in shapes but since your macro will
catch any such fields, it may be safer to use that one.

By the way, you have published a lot of helpful information and macro
solutions on your Website.


--
Regards
Lene Fredborg - Microsoft MVP (Word)
DocTools - Denmark
www.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word

 

[SteveB]

I have to say a very big Thank You to everyone who has helped provide
suggestions to solve this issue and in particular to Greg and Lene - Greg,
the scratchmacro you posted works brilliantly for my needs.

I was beginning to lose faith that anyone could help me solve this
particular issue and you just have.

Just to let you know the recipient of your help is an 80 year old music
teacher, Big Band arranger, conductor and pianist.

I have bookmarked both your websites too

Thanks

Steve

 

[Greg Maxey]

SteveB, Lene;

Thanks for your comments and approbation. Glad I could help.


--
Greg Maxey - Word MVP

My web site http://gregmaxey.mvps.org

I am not sure what "fails" means here - does the macro display an error or
does it not change any fields?

Note that if field codes are shown when you start the macro, none of the
fields will be changed due to the code line:

ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes

When field codes are shown, the line toggles the field codes off and TIME
is
not found.

Try to replace that line with:

ActiveWindow.View.ShowFieldCodes = True

and the corresponding line at the end of the macro with:

ActiveWindow.View.ShowFieldCodes = False

Does this solve the problem?

Note: You macro will replace any occurrence of the letters “time” with
“createtime” – this may result in undesired replacements in the document.
You
may want to use something like the following instead – it iterates though
all
stories in the document and checks the fields. If a TIME field is found,
it
is changed to a CREATEDATE field:

Sub ReplaceTimeFieldByCreateDateField()

Dim oField As Field
Dim oStory As Range

For Each oStory In ActiveDocument.StoryRanges
If Not oStory Is Nothing Then
For Each oField In oStory.Fields
If oField.Type = wdFieldTime Then
oField.Code.Text = _
Replace(oField.Code.Text, "TIME", "CREATEDATE")
End If
Next oField
End If
Next oStory

End Sub

--
Regards
Lene Fredborg - Microsoft MVP (Word)
DocTools - Denmarkwww.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word














- Show quoted text -

Lene,

I am sure that your code would be perfectly suitable 99.99% of the
time, but it will miss TIME fields that are contained in the TextRange
of shapes located in headers or footers. This is something that I
discovered when I was working on my VBA Find and Replace AddIn that is
posted on my website. To get them all you would need to process each
shape in the shaperange using something like this:

Sub ScratchMacro()
Dim rngstory As Word.Range
Dim oFld As Word.Field
Dim oShp As Word.Shape
Dim i As Long
'Handle unlinked sections
i = ActiveDocument.Sections(1).Headers(1).Range.StoryType
With ActiveDocument
For Each rngstory In .StoryRanges
'Iterate through all linked stories
Do
For Each oFld In rngstory.Fields
With oFld
If .Type = wdFieldTime Then
.Code.Text = Replace(oFld.Code.Text, "TIME",
"CREATEDATE")
End If
.Update
End With
Next oFld
On Error Resume Next
Select Case rngstory.StoryType
Case 6, 7, 8, 9, 10, 11
'Interate through all shapes in header/footers
If rngstory.ShapeRange.Count > 0 Then
For Each oShp In rngstory.ShapeRange
If oShp.TextFrame.HasText Then
For Each oFld In oShp.TextFrame.TextRange.Fields
With oFld
If oFld.Type = wdFieldTime Then
oFld.Code.Text = _
Replace(oFld.Code.Text, "TIME", "CREATEDATE")
End If
.Update
End With
Next oFld
End If
Next oShp
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next rngstory
End With
End Sub

Thought you would like to know.

 

[Graham Mayor]

You asked for - and were given - a macro to do this on the 4th? Did you not
read the replies to your earlier thread?

Sub BatchFixDates()
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim iFld As Integer
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
.Title = "Select Folder containing the documents to be modifed and click
OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User"
Exit Sub
End If
PathToUse = fDialog.SelectedItems.Item(1)
If Right(PathToUse, 1) <> "\" Then PathToUse = PathToUse + "\"
End With

If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
myFile = Dir$(PathToUse & "*.do?")

While myFile <> ""
Set myDoc = Documents.Open(PathToUse & myFile)
ActiveWindow.View.ShowFieldCodes = True
For iFld = ActiveDocument.Fields.Count To 1 Step -1
With ActiveDocument.Fields(iFld)
If .Type = wdFieldDate Then
.Code.Text = Replace(UCase(.Code.Text), "DATE", "CREATEDATE")
.Update
End If
If .Type = wdFieldTime Then
.Code.Text = Replace(UCase(.Code.Text), "TIME", "CREATEDATE")
.Update
End If
End With
Next iFld
ActiveWindow.View.ShowFieldCodes = False
myDoc.Close SaveChanges:=wdSaveChanges
myFile = Dir$()
Wend
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Graham Mayor]

To ensure that the fields are replaced in header and footer where they exist
you can address each section, each header and each footer separately. The
following variation on the previous message will do that:

Sub BatchFixDates()
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim iFld As Integer
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oFooter As HeaderFooter
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
.Title = "Select Folder containing the documents to be modifed and click
OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User"
Exit Sub
End If
PathToUse = fDialog.SelectedItems.Item(1)
If Right(PathToUse, 1) <> "\" Then PathToUse = PathToUse + "\"
End With

If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
myFile = Dir$(PathToUse & "*.do?")

While myFile <> ""
Set myDoc = Documents.Open(PathToUse & myFile)
ActiveWindow.View.ShowFieldCodes = True

For Each oSection In ActiveDocument.Sections
For iFld = ActiveDocument.Fields.Count To 1 Step -1
With ActiveDocument.Fields(iFld)
If .Type = wdFieldDate Then
.Code.Text = Replace(UCase(.Code.Text), "DATE",
"CREATEDATE")
.Update
End If
If .Type = wdFieldTime Then
.Code.Text = Replace(UCase(.Code.Text), "TIME",
"CREATEDATE")
.Update
End If
End With
Next iFld
For Each oHeader In oSection.Headers
If oHeader.Exists Then
For Each oField In oHeader.Range.Fields
With oField
If .Type = wdFieldDate Then
.Code.Text = Replace(UCase(.Code.Text), "DATE",
"CREATEDATE")
.Update
End If
If .Type = wdFieldTime Then
.Code.Text = Replace(UCase(.Code.Text), "TIME",
"CREATEDATE")
.Update
End If
End With
Next oField
End If
Next oHeader
For Each oFooter In oSection.Footers
If oFooter.Exists Then
For Each oField In oFooter.Range.Fields
With oField
If .Type = wdFieldDate Then
.Code.Text = Replace(UCase(.Code.Text), "DATE",
"CREATEDATE")
.Update
End If
If .Type = wdFieldTime Then
.Code.Text = Replace(UCase(.Code.Text), "TIME",
"CREATEDATE")
.Update
End If
End With
Next oField
End If
Next oFooter
Next oSection

ActiveWindow.View.ShowFieldCodes = False
myDoc.Close SaveChanges:=wdSaveChanges
myFile = Dir$()
Wend
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[SteveB]

Failed means that it ran successful without taking any action on fields in
the headers.

the scratchmacro solved it

 

[SteveB]

..

 

[Graham Mayor]

Had you pointed that out in the earlier thread we could have progressed
there. Are you saying that the second version of my macro in this thread
doesn't work for you? What part of it doesn't work?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>