Outlook Header wissen met macro

Option Explicit

Public Sub CopyWithoutMessageHeader() 'am_2019
    Dim lngBodyFormat As Long
    Dim strBCC As String
    Dim strBody As String
    Dim strCC As String
    Dim strHTMLBody As String
    Dim strSubject As String
    Dim strTo As String
    With ActiveExplorer.Selection.Item(1)
        If .Class = olMail Then
            strTo = .SenderEmailAddress
            strCC = .CC
            strBCC = .BCC
            strSubject = .Subject
            lngBodyFormat = .BodyFormat
            strBody = .Body
            strHTMLBody = .HTMLBody
        Else
            Exit Sub
        End If
    End With
    With CreateObject("Outlook.Application").CreateItem(olMailItem)
        .To = strTo
        .CC = strCC
        .BCC = strBCC
        .Subject = strSubject
        If lngBodyFormat <> 2 Then    'olFormatHTML 2 HTML-indeling, olFormatPlain 1 Indeling zonder opmaak, olFormatRichText 3 RTF-indeling, olFormatUnspecified 0 Indeling is niet opgegeven
            .Body = strBody
        Else
            .HTMLBody = strHTMLBody
        End If
        .Display
    End With
    With ActiveInspector
        If .IsWordMail And .EditorType = olEditorWord Then
            With .WordEditor.Content
                With .Find
                    .Text = "lokaal"
                    .Execute
                End With
                .Select
                .Application.Selection.MoveRight
            End With
        End If
    End With
End Sub

Option explicit

Public Sub ReplyWithoutMessageHeader()    'am_2019
    Dim avntHeader As Variant
    Dim iavntHeader As Long
    Dim objParagraph As Object

    avntHeader = Array("-----Oorspronkelijk bericht-----", "Van:", "Verzonden:", "Aan:", "Onderwerp:")   'change

    With ActiveExplorer.Selection.Item(1)
        If .Class = olMail Then
            .Reply.Display
            With ActiveInspector
                If .IsWordMail And .EditorType = olEditorWord Then
                    For Each objParagraph In .WordEditor.Paragraphs
                        With objParagraph.Range
                            For iavntHeader = LBound(avntHeader) To UBound(avntHeader)
                                If .Text Like avntHeader(iavntHeader) & "*" Then
                                    .Delete
                                    Exit For
                                End If
                            Next
                        End With
                    Next
                    With .WordEditor.Content
                        With .Find
                            .Text = "lokaal"
                            .Execute
                        End With
                        .Select
                        .Application.Selection.MoveRight
                    End With
                End If
            End With
        End If
    End With
End Sub