Excel VBA: Replace/convert date fields in header and footer to sample text

Question

I need an excel macro to replace all date fields in the header and footer to a sample text like "here was a date" and unlink all other fields. I have a solution already for Word but I don't know how to do it in Excel. This word macro will unlink all fields and search for date and time fields and replace it with a sample text.

Here is my macro for Word:

Sub AutoOpen()

    Dim oField As Field, bErrMark As Boolean, strPrompt As String, bFieldCodeHidden As Boolean
    Dim oStory As Range
    Const strREPLACETEXT = "{TIME\@dd.MMMM.yyyy}" ' Text für die Ersetzung
    
    On Error GoTo OOPS
    Let bFieldCodeHidden = ActiveWindow.View.ShowFieldCodes
    Let ActiveWindow.View.ShowFieldCodes = True

    For Each oStory In ActiveDocument.StoryRanges
        With oStory.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "^d Date"
            .Replacement.Text = strREPLACETEXT
            .Execute Replace:=wdReplaceAll
            .Text = "^d Time"
            .Execute Replace:=wdReplaceAll
        End With
    Next oStory
    
    Let strPrompt = "Alle Felder wurden mit dem folgenden Wert ersetzt. " & strREPLACETEXT
    GoTo ResumeMacro

OOPS:
    Let strPrompt = "Es gab ein Problem bei der Verarbeitung des Makros."
    
ResumeMacro:
    
    With ActiveDocument.Range.Find
        .ClearFormatting
        .Text = ""
        .Replacement.ClearFormatting
        .Replacement.Text = ""
    End With
    Application.ScreenUpdating = True
    Application.ScreenRefresh
    Set oField = Nothing

    Set oStory = Nothing
    Let ActiveWindow.View.ShowFieldCodes = bFieldCodeHidden
    On Error GoTo -1

With ActiveDocument
    If .ProtectionType = wdAllowOnlyRevisions Then
        .Unprotect
    End If
    .TrackRevisions = False
    .ShowRevisions = False
End With

ActiveDocument.Fields.Unlink

Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oFooter As HeaderFooter

For Each oSection In ActiveDocument.Sections

    For Each oHeader In oSection.Headers
        If oHeader.Exists Then
            For Each oField In oHeader.Range.Fields
            
            'Überprüfen ob Seitennummer
            If oField.Type = wdFieldPage Then
            Else
            oField.Unlink
            End If
            
            Next oField
        End If
    Next oHeader

    For Each oFooter In oSection.Footers
        If oFooter.Exists Then
             For Each oField In oFooter.Range.Fields
             
            'Überprüfen ob Seitennummer
            If oField.Type = wdFieldPage Then
            Else
            oField.Unlink
            End If

            Next oField
        End If
    Next oFooter
Next oSection

ActiveDocument.Save
ActiveDocument.Close
Application.Quit

End Sub

***Move from Deutsch Microsoft 365 und Office/ Unbekannt/ Windows***

Answer 1

Hello Robin,

Thank you for posting in this community.

I understand you encountered some problems when using VBA to replace all date fields in the header and footer with sample text.

I would like to explain we are supporting for family or consumer user to provide technical support, your issue is related to VBA which is for IT or Developer and is more appropriate to be posted in Microsoft Docs. There are more professional engineers who is familiar with VBA can provide help.

Your understanding is highly appreciated! Hope you are keeping safe and well.

Olivia - MSFT | Microsoft Community Support Specialist

---