AutoOpen code to change date code to date text

macropod · #7 02-15-2020, 01:41 PM

No, that makes no sense at all, because you have failed to realise what the effect would be, which is to lock in whatever date you process those documents on - not the dates the documents were created, printed or saved (whichever is relevant).

Any macro you run against the document to unlink DATE fields will only do so after those fields have updated. In other words, you will have already lost the date you're trying to preserve. That is the fundamental flaw in relying on code that simply unlinks existing DATE fields. You may be able to correct the problem by changing the DATE fields to CREATEDATE fields. Unlike DATE fields, CREATEDATE fields only update when the document is first saved or is saved via Save As.

Other possibilities for retrieving (but not necessarily retaining) the relevant dates are PRINTDATE fields (which record when the document was last printed) or SAVEDATE fields (which record when the document was last saved). Do note that any change to the field type will require the document to be re-saved, which will inevitably change the results of a SAVEDATE field. Of course, you might use a SAVEDATE field to capture the date the document was last saved, then unlink that field before re-saving the document.

For example, to replace DATE fields with CREATEDATE fields anywhere in the document (other than textboxes), you might use code like:

Code:

Sub GetDateCreated()
Application.ScreenUpdating = False
Dim Sctn As Section, HdFt As HeaderFooter, Fld As Field
With ActiveDocument
  For Each Fld In .Range.Fields
    If Fld.Type = wdFieldDate Then
      Fld.Code.Text = Replace(Fld.Code.Text, "DATE", "CREATEDATE")
    End If
  Next Fld
  For Each Sctn In .Sections
    For Each HdFt In Sctn.Headers
      With HdFt
        If .Exists Then
          If Sctn.Index = 1 Or .LinkToPrevious = False Then
            For Each Fld In .Range.Fields
              If Fld.Type = wdFieldDate Then
                Fld.Code.Text = Replace(Fld.Code.Text, "DATE", "CREATEDATE")
              End If
            Next Fld
          End If
        End If
      End With
    Next HdFt
    For Each HdFt In Sctn.Footers
      With HdFt
        If .Exists Then
          If Sctn.Index = 1 Or .LinkToPrevious = False Then
            For Each Fld In .Range.Fields
              If Fld.Type = wdFieldDate Then
                Fld.Code.Text = Replace(Fld.Code.Text, "DATE", "CREATEDATE")
              End If
            Next Fld
          End If
        End If
      End With
    Next HdFt
  Next Sctn
End With
Application.ScreenUpdating = True
End Sub

Whichever approach you take, you'll still need to verify that the new dates are correct - by reference to the original documents. Assuming you have those, you'll know what the dates should be changed back to, in which case you could use code like:

Code:

Sub DateCorrector()
Application.ScreenUpdating = False
Dim StrDt As Variant, Sctn As Section, HdFt As HeaderFooter, Fld As Field, Rng As Range
StrDt = InputBox("Please Input the Correct Date", "Date Fixer")
If IsDate(StrDt) Then
  StrDt = CDate(StrDt)
Else
  MsgBox "Not a valid date! Exiting", vbCritical
End If
With ActiveDocument
  For Each Fld In .Range.Fields
    If Fld.Type = wdFieldDate Then
      Set Rng = Fld.Result
      Fld.Unlink
      Rng.Text = Format(StrDt, "MMM-DD-YYYY")
    End If
  Next Fld
  For Each Sctn In .Sections
    For Each HdFt In Sctn.Headers
      With HdFt
        If .Exists Then
          If Sctn.Index = 1 Or .LinkToPrevious = False Then
            For Each Fld In .Range.Fields
              If Fld.Type = wdFieldDate Then
                Set Rng = Fld.Result
                Fld.Unlink
                Rng.Text = Format(StrDt, "MMM-DD-YYYY")
              End If
            Next Fld
          End If
        End If
      End With
    Next HdFt
    For Each HdFt In Sctn.Footers
      With HdFt
        If .Exists Then
          If Sctn.Index = 1 Or .LinkToPrevious = False Then
            For Each Fld In .Range.Fields
              If Fld.Type = wdFieldDate Then
                Set Rng = Fld.Result
                Fld.Unlink
                Rng.Text = Format(StrDt, "MMM-DD-YYYY")
              End If
            Next Fld
          End If
        End If
      End With
    Next HdFt
  Next Sctn
End With
Application.ScreenUpdating = True
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Change font color if date in column F is prior to today's date.	kevinbradley57	Excel Programming	1	12-05-2018 07:35 PM
VBA Code to search for field codes with certain text before the Field code and to change style	welcometocandyland	Word VBA	4	02-08-2017 06:53 PM
VBA code for inserting a future date	cosmopolitan	Word VBA	1	08-14-2013 01:58 PM
Change format of date when using Now function in VB code	Bondai	Excel Programming	2	03-02-2012 05:09 PM
Imported message date change to today's date	promark	Outlook	1	12-23-2005 07:21 AM