View Single Post
 
Old 02-15-2020, 01:41 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote