Sub FixDates()
Dim
sSwitch
As String
Dim iFld
As Integer
'Set the required date
switch - note the quotes
sSwitch = " \@ ""d MMMM yyyy"""
'Check each field in
the document
For iFld =
ActiveDocument.Fields.Count
To 1
Step -1
With
ActiveDocument.Fields(iFld)
Select Case .Type
'The field is a
Date field
Case Is = wdFieldDate
'Change it to a Createdate field
.Code.Text =
Replace(UCase(.Code.Text), _
"DATE", "CREATEDATE")
'If there is no date switch - add one
If InStr(1, .Code, "\@")
= 0 Then
.Code.Text = .Code.Text
& sSwitch
End If
.Update
Case Else
End Select
End With
Next iFld
End Sub
Sub
BatchFixDates()
Dim strFile
As
String
Dim strPath
As
String
Dim sSwitch
As
String
Dim strDoc
As Document
Dim iFld As
Integer
Dim fDialog
As FileDialog
'Set the required date
switch - note the quotes
sSwitch = " \@ ""d MMMM yyyy"""
Set fDialog =
Application.FileDialog(msoFileDialogFolderPicker)
'Get the folder
containing the documents
With fDialog
.title = "Select folder
containing the documents to be processed and
click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If
.Show <> -1
Then
MsgBox "Cancelled By
User", , "List Folder Contents"
Exit Sub
End If
strPath =
fDialog.SelectedItems.Item(1)
If
Right(strPath, 1) <> "\"
Then strPath = strPath + "\"
End With
'If there are any open
documents, close them (prompting to save changes)
If Documents.Count > 0
Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
strFile = Dir$(strPath & "*.doc")
'Open each document in
the folder
While strFile <> ""
Set
strDoc = Documents.Open(strPath &
strFile)
'Check each field in the document
For
iFld = ActiveDocument.Fields.Count
To 1
Step -1
With
ActiveDocument.Fields(iFld)
'The
field is a Date field
Select
Case .Type
Case Is = wdFieldDate
'Change it to a Createdate field
.Code.Text =
Replace(UCase(.Code.Text), _
"DATE", "CREATEDATE")
'If there is no date switch - add one
If InStr(1, .Code, "\@")
= 0 Then
.Code.Text = .Code.Text
& sSwitch
End If
.Update
Case Else
End Select
End With
Next
iFld
'Save the changes
strDoc.Close SaveChanges:=wdSaveChanges
strFile = Dir$()
Wend
End Sub