how can I get a date field with format replaced using a macro

[SteveB]

Hello, I have approximately 1000 documents created in Word 6 which include a
date field in the header. This should show the create date of the document.
In Word 2003 this shows as the current date.

The field format is as follows:-

{TIME \@ "dd MMMM yyyy"}

And I have worked out that this needs to be updated to:-

{"CREATEDATE \* "dd MMMM yyyy" \* MERGEFORMAT}

If I record a macro as below (which works on the document as I am recording
it) then it fails to execute when called in other documents.
I strongly suspect that the quotes are the issue or it might possibly be
related to the fact the field is in a header, but have no idea how to resolve
this.
Any help would be much appreciated.

Sub FANDRDATEFIELD()
'
' FANDRDATEFIELD Macro
' Macro recorded 03/08/2008 by Simun
'
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
..Text = "TIME \@ ""dd MMMM yyyy"""
..Replacement.Text = "CREATEDATE \* ""dd MMMM yyyy"" \* MERGEFORMAT"
..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
Selection.Fields.Update
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1, Name:=""
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
..Text = "TIME \@ ""dd MMMM yyyy"""
..Replacement.Text = "CREATEDATE \* ""dd MMMM yyyy"" \* MERGEFORMAT"
..Forward = True
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

 

[macropod]

Hi Steve,

Here's one way:

Option Explicit

Function GetFolder(Optional Title As String, Optional RootFolder As Variant) As String
On Error Resume Next
GetFolder = CreateObject("Shell.Application").BrowseForFolder(0, Title, 0, RootFolder).Items.Item.Path
End Function

Sub ResetDateFields()
Dim Appfs As Object
Dim i As Integer
Dim pRange As Word.Range
Dim TrkStatus As Boolean
Application.ScreenUpdating = False
ActiveWindow.View.ShowFieldCodes = True
Dim CurrDoc As Object
Set Appfs = Application.FileSearch
With Appfs
.LookIn = GetFolder(Title:="Find a Folder", RootFolder:=&H400)
.FileName = "*.doc"
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "I have found " & .FoundFiles.Count & " Word document(s) to process."
For i = 1 To .FoundFiles.Count
Set CurrDoc = Documents.Open(.FoundFiles(i))
With CurrDoc
TrkStatus = .TrackRevisions
.TrackRevisions = False
For Each pRange In .StoryRanges
Do
With .Content.Find
.ClearFormatting
.Text = "TIME \@ ""dd MMMM yyyy"""
.Replacement.Text = "CREATEDATE \* ""dd MMMM yyyy"""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Set pRange = pRange.NextStoryRange
Loop Until pRange Is Nothing
Next
.TrackRevisions = TrkStatus
.Save
.Close
End With
Next i
MsgBox "Finished!"
Else
MsgBox "There were no files found."
End If
End With
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
End Sub

 

[Graham Mayor]

\* "dd MMMM yyyy" is not a valid switch -
http://www.gmayor.com/formatting_word_fields.htm
the \*Mergeformat switch is usually superfluous and can cause formatting
problems. What you appear to need is to replace the Time field with a
Createdate field. That can be done fairly simply:

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


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

 

[macropod]

Hi Steve,

Oops, replacement text copied from your post without checking. Change:
..Replacement.Text = "CREATEDATE \* ""dd MMMM yyyy"""
to
..Replacement.Text = "CREATEDATE \@ ""dd MMMM yyyy"""


--
Cheers
macropod
[MVP - Microsoft Word]

Hi Steve,

Here's one way:

Option Explicit

Function GetFolder(Optional Title As String, Optional RootFolder As Variant) As String
On Error Resume Next
GetFolder = CreateObject("Shell.Application").BrowseForFolder(0, Title, 0, RootFolder).Items.Item.Path
End Function

Sub ResetDateFields()
Dim Appfs As Object
Dim i As Integer
Dim pRange As Word.Range
Dim TrkStatus As Boolean
Application.ScreenUpdating = False
ActiveWindow.View.ShowFieldCodes = True
Dim CurrDoc As Object
Set Appfs = Application.FileSearch
With Appfs
.LookIn = GetFolder(Title:="Find a Folder", RootFolder:=&H400)
.FileName = "*.doc"
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "I have found " & .FoundFiles.Count & " Word document(s) to process."
For i = 1 To .FoundFiles.Count
Set CurrDoc = Documents.Open(.FoundFiles(i))
With CurrDoc
TrkStatus = .TrackRevisions
.TrackRevisions = False
For Each pRange In .StoryRanges
Do
With .Content.Find
.ClearFormatting
.Text = "TIME \@ ""dd MMMM yyyy"""
.Replacement.Text = "CREATEDATE \* ""dd MMMM yyyy"""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Set pRange = pRange.NextStoryRange
Loop Until pRange Is Nothing
Next
.TrackRevisions = TrkStatus
.Save
.Close
End With
Next i
MsgBox "Finished!"
Else
MsgBox "There were no files found."
End If
End With
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
End Sub

--
Cheers
macropod
[MVP - Microsoft Word]

Hello, I have approximately 1000 documents created in Word 6 which include a
date field in the header. This should show the create date of the document.
In Word 2003 this shows as the current date.

The field format is as follows:-

{TIME \@ "dd MMMM yyyy"}

And I have worked out that this needs to be updated to:-

{"CREATEDATE \* "dd MMMM yyyy" \* MERGEFORMAT}

If I record a macro as below (which works on the document as I am recording
it) then it fails to execute when called in other documents.
I strongly suspect that the quotes are the issue or it might possibly be
related to the fact the field is in a header, but have no idea how to resolve
this.
Any help would be much appreciated.

Sub FANDRDATEFIELD()
'
' FANDRDATEFIELD Macro
' Macro recorded 03/08/2008 by Simun
'
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "TIME \@ ""dd MMMM yyyy"""
.Replacement.Text = "CREATEDATE \* ""dd MMMM yyyy"" \* MERGEFORMAT"
.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
Selection.Fields.Update
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1, Name:=""
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "TIME \@ ""dd MMMM yyyy"""
.Replacement.Text = "CREATEDATE \* ""dd MMMM yyyy"" \* MERGEFORMAT"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

 

[SteveB]

how can I get a date field in a header replaced using a macro

Thanks, That works great !
But only if the field in in the main body of the document.
all my fields are in primary headers and I cannot work out how to select
this section so find and replace works there.

Like I say before whilst I am recording a macro to search and replace the
process works fine (replacing the field in the header even though my cursor
is sitting in the main doc text)

but when I rerun the macro it fails to replace any relevant field in headers.

this works when recording and again when run where the field is in the body
of a document.

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