If you mean the date inserted in the letters, then this is normal if you
have inserted a date field which simply reflects the system date of the PC.
To get the creation date you need to change the date fields to createdate
fields. If you have a lot of such documents then you can batch convert them.
If the date has been inserted from the InsertDate or Insert Field options
then you will have a DATE or TIME field followed by a formatting mask eg
{ DATE \@ "dd/MM/yyyy" }
or
{ TIME \@ "dd/MM/yyyy" }
You can use the replace function in a batch process to replace these with
{ CREATEDATE \@ "dd/MM/yyyy" }
then update them to reflect the original dates. The following code will do
that (provided the fields have been entered as described and have the
standard automatic syntax.) Test on sample documents placed in a new folder
for the purpose.
Use the following in conjunction with the instructions for the code on which
the code is based at
http://www.gmayor.com/batch_replace.htm
Public Sub BatchReplaceDATEField()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim MyDoc As Document
Dim rngstory As Word.Range
Dim findText As Variant
Dim Replacement As Variant
Dim i As Long
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
PathToUse = .Directory
Else
MsgBox "Cancelled by User"
Exit Sub
End If
End With
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
FirstLoop = True
If Left(PathToUse, 1) = Chr(34) Then
PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2)
End If
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
If FirstLoop = True Then
findText = Array(" TIME \@", " DATE \@")
End If
TryAgain:
Replacement = " CREATEDATE \@"
FirstLoop = False
Set MyDoc = Documents.Open(PathToUse & myFile)
ActiveWindow.View.ShowFieldCodes = True
MakeHFValid
For Each rngstory In ActiveDocument.StoryRanges
Do
With Selection.Find
For i = LBound(findText) To UBound(findText)
.Text = findText(i)
.Replacement.Text = Replacement
SearchAndReplaceInStory rngstory, findText(i), Replacement
Next i
End With
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
ActiveDocument.PrintPreview
ActiveDocument.ClosePrintPreview
ActiveWindow.View.ShowFieldCodes = False
MyDoc.Close SaveChanges:=wdSaveChanges
myFile = Dir$()
Wend
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
'This routine supplied by Peter Hewett
Do Until (rngstory Is Nothing)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.Execute replace:=wdReplaceAll
End With
Set rngstory = rngstory.NextStoryRange
Loop
End Sub
Public Sub MakeHFValid()
'And this too
Dim lngJunk As Long
' It does not matter whether we access the Headers or Footers property.
' The critical part is accessing the stories range object
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
End Sub
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
My web site
www.gmayor.com
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
